;============================================================================== ; ; VERSION FOR KANZELHOEHE SOLAR OBSERVATORY ; ; LAST MODIFICATION: JUNE 12, 2000 Michael Steinegger ; ;============================================================================= ; ; pulldown menu for inspecting/accepting data ; PRO INSPECT,parent,files,flag desc = [ '1\Inspect Data' , $ '0\Dark Frame' , $ '0\Flat Frame' , $ '0\Image Frame' , $ '0\Limb Frame' , $ '2\Residual Frame' , $ '0\Accept Data',$ '0\Cancel'] ;----- create the widget base = WIDGET_BASE(GROUP_LEADER=parent,/ALIGN_CENTER,$ TITLE='Inspect/Accept Data',ROW=1) menu = CW_PDMENU(base, desc, /RETURN_FULL_NAME) WIDGET_CONTROL, /REALIZE, base ;----- provide a simple event handler REPEAT BEGIN ev = WIDGET_EVENT(base) IF ev.value EQ 'Inspect Data.Dark Frame' THEN BEGIN SPAWN,'xv '+files(0)+'&',dum ev.VALUE = '' ENDIF IF ev.value EQ 'Inspect Data.Flat Frame' THEN BEGIN SPAWN,'xv '+files(1)+'&',dum ev.VALUE = '' ENDIF IF ev.value EQ 'Inspect Data.Image Frame' THEN BEGIN SPAWN,'xv '+files(2)+'&',dum ev.VALUE = '' ENDIF IF ev.value EQ 'Inspect Data.Limb Frame' THEN BEGIN SPAWN,'xv '+files(3)+'&',dum ev.VALUE = '' ENDIF IF ev.value EQ 'Inspect Data.Residual Frame' THEN BEGIN SPAWN,'xv '+files(4)+'&',dum ev.VALUE = '' ENDIF IF ev.value EQ 'Accept Data' THEN BEGIN flag='Yes' GOTO,ende ENDIF IF ev.value EQ 'Cancel' THEN BEGIN flag='No' GOTO,ende ENDIF ENDREP UNTIL ev.value EQ 'Exit' ende: WIDGET_CONTROL,/DESTROY,base END ; ; annotate image ; PRO IMG_ANNOTATE, hdr, img, img2, icon ;+ ; NAME: ; IMG_ANNOTATE ; ; PURPOSE: ; Annotate image with compass rose, date and time. ; ; CALLING SEQUENCE: ; IMG_ANNOTATE, hdr, img, img2, icon ; ; INPUTS: ; HDR: FITS header of the image. ; IMG: Full-disk solar image. ; ; OUTPUTS: ; IMG2: Half-sized annotated image. ; ICON: Iconized image. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; Unknown. ; 2000-05-23: Michael Steinegger, Big Bear Solar Observatory / NJIT ; Adopted for KSO images. ; ;- !P.FONT = 0 ;----- read BBSO icon ;;READ_JPEG, 'images/bbso_icon.jpg', icon_jpg ;----- get size dim = SIZE( img ) nx = dim( 1 ) nx2 = nx / 2 ny = dim( 2 ) ny2 = ny / 2 ;----- get date and time date = SXPAR( hdr, 'DATE-OBS' ) time = SXPAR( hdr, 'TIME-OBS' ) ;----- half size image and icon img2 = CONGRID( img, nx2, ny2, CUBIC = -0.5 ) icon = CONGRID( img2, 100, 100, CUBIC = -0.5 ) ;----- create full size www image in pixmap WINDOW, /PIXMAP, XSIZE = nx, YSIZE = ny TV, img ;;TV, icon_jpg, nx - 89, ny - 89 ;----- make compass rose DEVICE, SET_FONT = '-adobe-courier-bold-r-normal--34-240-100-100-m-200-iso8859-1' TV, BYTARR( 79, 79 ) + 255, 10, ny - 89 XYOUTS, 40, ny - 35, 'N', COLOR = 0, /DEVICE XYOUTS, 40, ny - 85, 'S', COLOR = 0, /DEVICE XYOUTS, 15, ny - 60, 'E', COLOR = 0, /DEVICE XYOUTS, 65, ny - 60, 'W', COLOR = 0, /DEVICE ;----- annotate DEVICE, SET_FONT ='-adobe-courier-bold-r-normal--14-100-100-100-m-90-iso8859-1' TV, BYTARR( 292, 40 ) + 255, 10, 10 XYOUTS, 15, 35, 'Kanzelhoehe Solar Observatory', COLOR = 0, /DEVICE XYOUTS, 15, 15, date + ' ' + time + ' UT', COLOR = 0, /DEVICE img = TVRD( ) ;----- create half size www image in pixmap WINDOW, /PIXMAP, XSIZE = nx2, YSIZE = ny2 TV, img2 ;;TV, icon_jpg, nx2 - 89, ny2 - 89 ;----- make compass rose DEVICE, SET_FONT = '-adobe-courier-bold-r-normal--34-240-100-100-m-200-iso8859-1' TV, BYTARR( 79, 79 ) + 255, 10, ny2 - 89 XYOUTS, 40, ny2 - 35, 'N', COLOR = 0, /DEVICE XYOUTS, 40, ny2 - 85, 'S', COLOR = 0, /DEVICE XYOUTS, 15, ny2 - 60, 'E', COLOR = 0, /DEVICE XYOUTS, 65, ny2 - 60, 'W', COLOR = 0, /DEVICE ;----- annotate DEVICE, SET_FONT ='-adobe-courier-bold-r-normal--14-100-100-100-m-90-iso8859-1' TV, BYTARR( 292, 40 ) + 255, 10, 10 XYOUTS, 15, 35, 'Kanzelhoehe Solar Observatory', COLOR = 0, /DEVICE XYOUTS, 15, 15, date + ' ' + time + ' UT', COLOR = 0, /DEVICE img2 = TVRD( ) ;----- reset window WDELETE RETURN END FUNCTION RESIDUAL_SMOOTH, prof, kernel, level ;+ ; NAME: ; RESIDUAL_SMOOTH ; ; PURPOSE: ; To smooth a limb darkening profile so that a wider kernel ; is used closer to disk center. ; ; CALLING SEQUENCE: ; prof = RESIDUAL_SMOOTH( prof, kernel, level ) ; ; INPUTS: ; PROF: Limb darkening profile. ; KERNEL: Kernel size at disk center. ; LEVEL: Cutoff level in percent of maximum disk brightness used for ; the smoothing of the limb darkening function. ; ; OUTPUTS: ; PROF: Smoothed limb darkening profile. ; ; KEYWORDS: ; None. ; ; PROCEDURE: ; Smoothing kernel size is decreasing proportional to the limb ; darkening profile out to a level LEVEL percent lower than the ; disk center level. ; ; MODIFICATION HISTORY: ; 1996-01-01: Anders Johanneson, Big Bear Solar Observatory ; Original verion of FD_SMOOT.PRO. ; 1999-12-18: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system. ; ;- ;----- get range array cutoff = level / 100.0 k_arr = kernel * ( ( prof / FLOAT( MAX( prof ) ) ) > cutoff - cutoff ) $ / ( 1.0 - cutoff ) ;----- smoothing (floating average) n = N_ELEMENTS( prof ) FOR i = 0, n - 1 DO BEGIN kern = BYTE( ROUND( k_arr( i ) ) ) IF ( kern MOD 2 ) EQ 0 THEN kern = kern + 1 IF kern GE 3 THEN BEGIN sum = 0.0 FOR k = -kern / 2, kern / 2 DO BEGIN j = i + k IF j LT 0 THEN j = 0 IF j GT ( n - 1 ) THEN j = n - 1 sum = sum + prof( j ) ENDFOR prof( i ) = sum / FLOAT( kern ) ENDIF ENDFOR RETURN, prof END FUNCTION RESIDUAL_DC_INT, prof, d, deg ; ; TO FIT N-TH ORDER POLYNOMIAL TO DC ; AJO OCT 96 ; ;----- make D an even integer d = FIX( ROUND( d ) ) IF ( d MOD 2) NE 0 THEN d = d - 1 ;----- prepare input prof = REFORM( prof) prof = [ REVERSE( prof ), prof ] y = prof n = N_ELEMENTS( y ) x = INDGEN( n ) ;----- fit polynomial x = x( n / 2 - d - 1 : n / 2 + d ) y = y( n / 2 - d - 1 : n / 2 + d ) c = POLY_FIT( x, y, deg, yfit, yband ) ;----- exclude outliers and refit index = WHERE( ABS( y - yfit ) GT 2 * yband, ct ) IF ct GT 0 THEN BEGIN c = POLY_FIT( x( index ), y( index), deg ) yfit = POLY( x, c ) ENDIF ;----- prepare output prof( n / 2 - d - 1 : n / 2 + d ) = yfit prof = prof( n / 2 : * ) RETURN, prof END FUNCTION RESIDUAL_LIMB, img, p, skern, cut_level, prof ;+ ; NAME: ; RESIDUAL_LIMB ; ; PURPOSE: ; To calculate the symmetric limb darkening function of a fulldisk ; image given the image. ; ; CALLING SEQUENCE: ; limb = RESIDUAL_LIMB( img, p, skern, cut_level, prof ) ; ; INPUTS: ; IMG: Input image. ; Cen = disk center coordinates ; Wid = disk width (pixels) ; Skern = maximum size of smoothing kernel ; Cut_level = Cutoff level for smoothing filter (%) ; ; OUTPUTS: ; LIMB: Limb darkening image. ; PROF: 1-dimensional limb darkening profile. ; ; KEYWORDS: ; None. ; ; PROCEDURE: ; Several tracins are made from the center and out using bilinear ; interpolation (using 'rad_prof.pro' see BBSO IDL library). These ; are median filtered for each radius used. The result is smoothed ; using wider smoothing kernels at the flatter part of the disk. ; High activity regions (containing fewer than 10 data points in a ; azimuthal tracin (usually at disc center) are excluded and the ; center region is instead filled in from a fit to a second order ; polynomial. ; ; MODIFICATION HISTORY: ; 1997-11-13: Anders Johanneson, Big Bear Solar Observatory ; Original verion of FD_SYMM.PRO. ; 1999-12-17: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures. ; ;- ;----- radial median filter r = FIX( ROUND( ( p.xd + p.yd ) / 4. ) ) DIST_CIRCLE, d, [ p.nx, p.ny ], p.xc, p.yc d = FIX( ROUND( d ) ) index = SORT ( d ) h = HISTOGRAM ( d ) prof = FLTARR( r + 1 ) r1 = 0 FOR i = 0, r DO BEGIN r2 = r1 + h( i ) - 1 prof ( i ) = MEDIAN( img( index( r1 : r2 ) ) ) r1 = r2 + 1 ENDFOR ;----- fit second order polynomial to inner 25% of the limb darkening profile ; using 50% instead of 25% seems to give better results ;prof = RESIDUAL_DC_INT( prof, r / 4.0, 2 ) prof = RESIDUAL_DC_INT( prof, r / 2.0, 2 ) ;----- filter limb darkening profile prof = RESIDUAL_SMOOTH( prof, skern, cut_level ) ;----- extend profile beyond sun limb = REPLICATE( prof( r ), p.nx, p.ny ) r1 = 0 FOR i = 0, r DO BEGIN r2 = r1 + h( i ) - 1 limb( index( r1 : r2 ) ) = prof ( i ) r1 = r2 + 1 ENDFOR RETURN, limb END FUNCTION FLAT_CLEAN, flat, center, p ;+ ; NAME: ; FLAT_CLEAN ; ; PURPOSE: ; Extrapolates missing values in Kuhn-Lin gain tables. Implicitly assumes ; that the gain table is defined in the image center. ; ; CATEGORY: ; BBSO Archiving System. ; Image Processing. ; ; CALLING SEQUENCE: ; flat = FLAT_CLEAN( flat, center, p ) ; ; INPUTS: ; FLAT: Kuhn-Lin gain table with missing values. ; CENTER: Center coordinates of reduced size image. ; P: STRUCTURE image specs. ; ; OUTPUTS: ; FLAT: Full size Kuhn-Lin gain table. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; 1999-12-16: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures, replaces slow CLEANFLAT.PRO ; ;- ;----- definition fill = flat ;----- distance from image center d = SHIFT( DIST( p.nxx, p.nyy ), p.nxx / 2, p.nyy / 2 ) ;----- sort distance array so that we actually work our way from the inside ;----- to the outside xy = SORT( d ) ;----- replace only missing values index = WHERE( fill( xy ) EQ 0, n ) xy = xy ( index ) ;----- x and y coordinates xx = xy mod p.nxx yy = xy / p.nxx ;----- fill the holes (zeros) from the center to the corner ;----- take care of the different quadrants and avoid problems with ;----- image borders FOR i = 0, n - 1 DO BEGIN IF xx( i ) GT p.nxx / 2 THEN x = xx( i ) - 1 ELSE x = xx( i ) IF yy( i ) GT p.nyy / 2 THEN y = yy( i ) - 1 ELSE y = yy( i ) fill( xy( i ) ) = MEDIAN ( fill( x : x + 1, y : y + 1 ) ) ENDFOR ;----- smooth image flat = fill fill = SMOOTH ( fill, 25, /EDGE_TRUNCATE ) ;----- use fill image outside limb and blend with sharp flat image DIST_CIRCLE, cim, [ p.nxx, p.nyy ], center( 0 ), center( 1 ) ;;mask = FLOAT( cim LT 0.7 * ( p.nyy / 2 ) ) ; 0.8 als cut-off ??? ;;mask = SMOOTH ( mask, 25, /EDGE_TRUNCATE ) ; use cos^2 profile between 0.7 and 0.9 of solar radius ; instead of sharp mask wo = WHERE( cim / ( p.nyy / 2. ) GT 0.7 ) mask = FLTARR( p.nxx, p.nyy ) + 1. mask( wo ) = COS( ( cim( wo ) / ( p.nyy / 2. ) - 0.7 ) / 0.2 * !PI / 2. ) ^ 2. mask( WHERE( cim / (p.nyy / 2. ) GT 0.9 ) ) = 0. flat = flat * mask + fill * ( 1.0 - mask ) ;----- smooth one final time ;;flat = SMOOTH( flat, 3, /EDGE_TRUNCATE ) ;----- resize image to original size flat = CONGRID( flat, p.nx, p.ny, /INTERP ) RETURN, flat END PRO FLAT_KUHN_LIN_I, con, gain, bitmap, cnt, p, disp ;+ ; NAME: ; FLAT_KUHN_LIN_I ; ; PURPOSE: ; Iterate Kuhn-Lin style gain table (see FLAT_KUHN_LIN.PRO). ; ; CATEGORY: ; BBSO Archiving System. ; Image Processing. ; ; CALLING SEQUENCE: ; FLAT_KUHN_LIN_I, con, gain, bitmap, cnt, p, disp ; ; INPUTS: ; CON: Constant term of the gain table. ; BITMAP: Bitmap containing good pixel for each input flat field frame. ; CNT: Valid pixel pair count. ; DISP: Array of displacements with respect to the centered image, also ; reduced in size. ; P: STRUCTURE image specs. ; ; OUTPUTS: ; GAIN: Reduced size gain table. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; 1997-10-27: Anders Johanneson, Big Bear Solar Observatory ; Original verion of DO_ITER.PRO. ; 1999-12-15: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures. ; ;- ;----- definitions loopct = 0 gain_n = con ;----- recompute gain FOR iq = 1, p.n - 1 DO BEGIN mskiq = bitmap / ( 2l^iq OR bitmap ) FOR ir = 0, iq - 1 DO BEGIN mskir = bitmap / ( 2l^iq OR bitmap ) dx = disp( 0, iq ) - disp( 0, ir ) dy = disp( 1, iq ) - disp( 1, ir ) jxl = MAX( [ 0, -dx ] ) jxh = MIN( [ 0, -dx ] ) + p.nxx - 1 jyl = MAX( [ 0, -dy ] ) jyh = MIN( [ 0, -dy ] ) + p.nyy - 1 ixl = MAX( [ 0, dx ] ) ixh = MIN( [ 0, dx ] ) + p.nxx - 1 iyl = MAX( [ 0, dy ] ) iyh = MIN( [ 0, dy ] ) + p.nyy - 1 msk = ( mskiq( jxl : jxh, jyl : jyh ) AND mskir( ixl : ixh, iyl : iyh ) ) gain_n( jxl : jxh, jyl : jyh ) = gain_n( jxl : jxh, jyl : jyh ) $ + gain( ixl : ixh, iyl : iyh ) * msk gain_n( ixl : ixh, iyl : iyh ) = gain_n( ixl : ixh, iyl : iyh ) $ + gain( jxl : jxh, jyl : jyh ) * msk loopct = loopct + 1 ENDFOR ENDFOR gain_n = gain_n / ( cnt > 1 ) index = WHERE( cnt EQ 0, ct ) IF ct GT 0 THEN gain_n( index ) = 0. index = WHERE( cnt GT 0, n ) ;----- calculate average of gain table for normalization ;------ Caution: must use double floats here! sum2 = TOTAL( DOUBLE( gain_n( index ) ) ) sum3 = TOTAL( DOUBLE( gain_n( index )^2 ) ) ;----- ignore pixels more than 5*sigma away from mean ave2 = sum2 / n five_sigma = 5 * SQRT( sum3 / n - ave2 * ave2 ) index = WHERE( ABS( gain_n - ave2 ) GT five_sigma, ct ) IF ct GT 0 THEN BEGIN sum2 = sum2 - TOTAL( DOUBLE( gain_n ( index ) ) ) n = n - ct ENDIF ;----- normalize this iteration's gain table ave2 = sum2 / n IF ct GT 0 THEN BEGIN gain_n = gain_n - ave2 sum3 = TOTAL( DOUBLE( ( gain_n - gain )^ 2 ) ) ENDIF gain = gain_n RETURN END FUNCTION FLAT_KUHN_LIN_C, flat, bitmap, disp, p, cnt ;+ ; NAME: ; FLAT_KUHN_LIN_C ; ; PURPOSE: ; Kuhn-Lin style flat field function. See Kuhn, Lin, and Loranz: "Gain ; Calibrating NonUniform Image-Array Data Using Only the Image Data", ; Publications of the Astronomy Society of the Pacific, 103: 1097-1108, ; October 1991. ; ; CATEGORY: ; BBSO Archiving System. ; Image Processing. ; ; CALLING SEQUENCE: ; con = FLAT_KUHN_LIN_C( flat, bitmap, disp, p, cnt ) ; ; INPUTS: ; FLAT: Array of reduced size input images. ; BITMAP: Bitmap containing good pixel for each input flat field frame. ; DISP: Array of displacements with respect to the centered image, also ; reduced in size. ; P: STRUCTURE image specs. ; ; OUTPUTS: ; CON: Constant term of the gain table. ; CNT: Valid pixel pair count. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; 1997-10-27: Anders Johanneson, Big Bear Solar Observatory ; Original verion of GET_CONST.PRO. ; 1999-12-15: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures. ; ;- ;----- definitions loopct = 0 con = FLTARR( p.nxx, p.nyy ) dat = FLTARR( p.nxx, p.nyy, p.n ) cnt = FLTARR( p.nxx, p.nyy ) ma = MACHAR( ) ;----- compute constant term dat( *, *, 0 ) = ALOG10( flat( *, *, 0 ) > ma.xmin ) FOR iq = 1, p.n - 1 DO BEGIN dat( *, *, iq ) = ALOG10( flat( *, *, iq ) > ma.xmin ) ;----- retrieve good pixel from bitmap mskiq = bitmap / ( 2l^iq OR bitmap ) FOR ir = 0, iq - 1 DO BEGIN mskir = bitmap / ( 2l^ir OR bitmap ) dx = disp( 0, iq ) - disp( 0, ir ) dy = disp( 1, iq ) - disp( 1, ir ) jxl = MAX( [ 0, -dx ] ) jxh = MIN( [ 0, -dx ] ) + p.nxx - 1 jyl = MAX( [ 0, -dy ] ) jyh = MIN( [ 0, -dy ] ) + p.nyy - 1 ixl = MAX( [ 0, dx ] ) ixh = MIN( [ 0, dx ] ) + p.nxx - 1 iyl = MAX( [ 0, dy ] ) iyh = MIN( [ 0, dy ] ) + p.nyy - 1 msk = ( mskiq( jxl : jxh, jyl : jyh ) AND mskir( ixl : ixh, iyl : iyh ) ) diff = ( dat( jxl : jxh, jyl : jyh, iq) - dat( ixl : ixh, iyl : iyh, $ ir ) ) * msk con( jxl : jxh, jyl : jyh ) = con( jxl : jxh, jyl : jyh ) + diff con( ixl : ixh, iyl : iyh ) = con( ixl : ixh, iyl : iyh ) - diff cnt( jxl : jxh, jyl : jyh ) = cnt( jxl : jxh, jyl : jyh ) + msk cnt( ixl : ixh, iyl : iyh ) = cnt( ixl : ixh, iyl : iyh ) + msk loopct = loopct + 1 ENDFOR ENDFOR RETURN, con END FUNCTION FLAT_KUHN_LIN, flat, disp, p ;+ ; NAME: ; FLAT_KUHN_LIN ; ; PURPOSE: ; Kuhn-Lin style flat field function. See Kuhn, Lin, and Loranz: "Gain ; Calibrating NonUniform Image-Array Data Using Only the Image Data", ; Publications of the Astronomy Society of the Pacific, 103: 1097-1108, ; October 1991. ; ; CATEGORY: ; BBSO Archiving System. ; Image Processing. ; ; CALLING SEQUENCE: ; flat = FLAT_KUHN_LIN( flat, disp, p ) ; ; INPUTS: ; FLAT: Array of reduced size input images. ; DISP: Array of displacements with respect to the centered image, also ; reduced in size. ; P: STRUCTURE image specs. ; ; OUTPUTS: ; FLAT: Reduced size flat field frame. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; 1997-10-27: Anders Johanneson, Big Bear Solar Observatory ; Original verion of LINFLAT.PRO. ; 1999-12-15: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures, removed the need for the SETBIT.PRO, GETBIT.PRO, and ; ITERATE.PRO functions. ; ;- ;----- number of iterations n = 10 ;----- create bitmap by thresholding rmin = LONG( ROUND ( 0.70 * p.int ) ) rmax = LONG( ROUND ( 1.05 * p.int ) ) bitmap = LONARR ( p.nxx, p.nyy ) IF p.n GE 32 THEN RETURN, -1 ;----- too many flat field frames FOR i = 0, p.n - 1 DO bitmap = bitmap + ( ( flat( *, *, i ) GE rmin ) $ AND ( flat( *, *, i ) LE rmax ) ) * 2l^i IF p.n LT 16 THEN bitmap = FIX( bitmap ) ;----- INTEGER bitmap IF p.n LE 8 THEN bitmap = BYTE( bitmap );----- BYTE bitmap ;----- get algorithm's constant term and calculate the valid pixel pair count con = FLAT_KUHN_LIN_C( flat, bitmap, disp, p, cnt ) ;----- start with unit gain, no need to call DO_ITER now, since the initial ;----- guess is gain = 0 gain = con / ( cnt > 1 ) ;----- iterate the gain FOR i = 0, n - 1 DO FLAT_KUHN_LIN_I, con, gain, bitmap, cnt, p, disp flat = 10.^gain * ( bitmap NE 0 ) RETURN, flat END FUNCTION CENTER_SOBEL, img, p, ccd ;+ ; NAME: ; CENTER_SOBEL ; ; PURPOSE: ; Calculate diameter and center coordinates of synoptic full disk ; images. If the solar image is not centered, CENTER_SOBEL returns ; the disk center coordinates and the diameter values are set to -1. ; ; CATEGORY: ; BBSO Archiving System. ; Image Processing. ; ; CALLING SEQUENCE: ; co = CENTER_SOBEL( img, p, ccd ) ; ; INPUTS: ; IMG: Image frame. ; P: STRUCTURE image specs. ; CCD: STRUCTURE camera specs. ; ; OUTPUTS: ; CO: LONG array [ center coordinate X, center coordinate Y, diameter X, ; diameter Y ]. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; 1995-12-04: Anders Johanneson, Big Bear Solar Observatory ; Original verion of AJEDCENT.PRO. ; 1999-12-13: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures, off-center images via CO keyword, information via ; MESSAGE procedure. ; 2000-05-18: Michael Steinegger, Big Bear Solar Observatory ; The Sobel function is only used to obtain the first guess for the ; center and radius, the exact values are obtained by fitting a ; circle to the Sobel function using FIT_CIRCLE.PRO. ; 2000-06-06: Michael Steinegger, Big Bear Solar Observatory ; Ocaccional problems with shifted images solved. ; ;- ;----- find the limb by using a non-linear edge enhancement operator ;lim = MEDIAN ( img ) / 4. This might be a potential problem!!! ;lim = MEDIAN ( img ) / 5. This is a problem for some KSO images!! lim = MEAN( img ) / 5. ;;mask = ( SOBEL( img ) GT lim ) mask = ( SOBEL( SMOOTH( img, 10, /edge_truncate ) ) GT lim ) ;----- elminate problems with borders and a few bad columns IF ccd.fdr EQ '' THEN type = 'h' ELSE type = STRMID( ccd.fdr, 0, 1 ) CASE type OF 'h': xo = 15 ELSE: xo = 50 ENDCASE b = 4 mask( *, p.ny - b -1 : * ) = 0 mask( *, 0 : b - 1 ) = 0 mask( 0 : b - 1 + xo, * ) = 0 mask( p.nx - b - 1 : *, * ) = 0 ;----- get x-coordinates and diameter ;xx = TOTAL( mask, 2 ) GT 0 ;----- horizontal sum xx = TOTAL( mask, 2 ) GT 3 ; this should give a better radius ;----- solar image is centered in x IF ( xx( b + xo ) EQ 0 ) AND ( xx( p.nx - b - 2 ) EQ 0 ) THEN BEGIN index = WHERE( xx, n ) x1 = index( 0 ) x2 = index( n - 1 ) xd = x2 - x1 + 1 xc = xd / 2 + x1 ENDIF ;----- solar image is on the left IF ( xx( b + xo ) EQ 1 ) AND ( xx( p.nx - b - 2 ) EQ 0 ) THEN BEGIN xx( 0 : b + xo - 1 ) = 1 ;----- set border to 1 index = WHERE( 1 - xx ) x2 = index( 0 ) - 1 xd = -1 xc = x2 - p.xd / 2 ENDIF ;----- solar image is on the right IF ( xx( b + xo ) EQ 0 ) AND ( xx( p.nx - b - 2 ) EQ 1 ) THEN BEGIN index = WHERE( xx ) x1 = index( 0 ) xd = -1 xc = x1 + p.xd / 2 ENDIF ;----- get y-coordinates and diameter ;yy = TOTAL( mask, 1 ) GT 0 ;----- vertical sum yy = TOTAL( mask, 1 ) GT 3 ; this should give a better radius ;----- solar image is centered in y IF ( yy( b ) EQ 0 ) AND ( yy( p.ny - b - 2 ) EQ 0 ) THEN BEGIN index = WHERE( yy, n ) y1 = index( 0 ) y2 = index( n - 1 ) yd = y2 - y1 + 1 yc = yd / 2 + y1 ENDIF ;----- solar image is on the bottom IF ( yy( b ) EQ 1 ) AND ( yy ( p.ny - b - 2 ) EQ 0 ) THEN BEGIN yy( 0 : b - 1 ) = 1 ;----- set border to 1 index = WHERE( 1 - yy ) y2 = index( 0 ) - 1 yd = -1 yc = y2 - p.yd / 2 ENDIF ;----- solar image is on the top IF ( yy( b ) EQ 0 ) AND ( yy( p.ny - b - 2 ) EQ 1 ) THEN BEGIN index = WHERE( yy ) y1 = index( 0 ) yd = -1 yc = y1 + p.yd / 2 ENDIF ;----- check initial guesses for diameter IF xd EQ -1 AND yd EQ -1 THEN xd = p.xd IF xd EQ -1 AND yd NE -1 THEN xd = yd IF yd EQ -1 AND xd NE -1 THEN yd = xd ;----- eliminate center of the disk (active regions!) r = FIX( ROUND( ( p.xd + p.yd ) / 4. ) ) DIST_CIRCLE, d, [ p.nx, p.ny ], xc, yc ;;mask( WHERE( d LT r * 0.95 OR d GT r * 1.1 ) ) = 0 mask( WHERE( d LT r * 0.9 OR d GT r * 1.1 ) ) = 0 ; for KSO images ;----- fit a circle to obtain radius and center coordinates, ; iterate until all points are within 2 * sigma of radius bad = [0L] WHILE bad( 0 ) NE -1 DO BEGIN wo = WHERE( mask GT 0 ) xfit = wo MOD p.nx yfit = wo / FLOAT( p.nx ) result = FIT_CIRCLE( xfit, yfit, [ xc, yc, r ] ) radius = SQRT( ( xfit - result( 0 ) ) ^ 2. + ( yfit - result( 1 ) ) ^ 2. ) sigma = SQRT ( TOTAL( ( radius - result( 2 ) ) ^ 2. ) / $ ( N_ELEMENTS ( wo ) - 1 ) ) bad = WHERE( radius GT ( result( 2 ) + 2. * sigma ) OR $ radius LT ( result( 2 ) - 2. * sigma ) ) IF bad( 0 ) NE -1 THEN BEGIN mask( xfit( bad ), yfit( bad) ) = 0 xc = FIX( ROUND ( result( 0 ) ) ) yc = FIX( ROUND ( result( 1 ) ) ) xd = FIX( ROUND ( result( 2 ) * 2. ) ) yd = xd ;; r = ( xd + yd ) / 4. r = ( p.xd + p.yd ) / 4. ;; print,sigma,bad(0),N_ELEMENTS(bad), xc, yc, xd ENDIF ENDWHILE yd = xd RETURN, [ xc, yc, xd, yd ] END PRO flatfield, wid, date ;+ ; NAME: ; FLATFIELD ; ; PURPOSE: ; Calculate flatfield (Kuhn-Lin algorithm) and center-limb-variation for ; a full-disk solar image. Correct solar image for dark current, flat field ; and produce a contrast enhanced image. ; ; This program is called by archiv_tool.pro. ; ; CATEGORY: ; BBSO Archiving System. ; Image Processing. ; ; CALLING SEQUENCE: ; FLATFIELD, wid, date ; ; INPUTS: ; WID: widget ID ; DATE: observing date of the solar image in the format [yyyy,mm,dd] ; ; OUTPUTS: ; Resulting images are written first to a temporary archive and are ; then transferred to the FITS, WWW and FTP archives. ; ; KEYWORDS: ; None. ; ; MODIFICATION HISTORY: ; 1995-??-??: Anders Johanneson, Big Bear Solar Observatory ; 1999-12-13: Carsten Denker, Big Bear Solar Observatory ; Intergration in the new BBSO archiving system, variables are passed ; as structures. ; 2000-03-24: Michael Steinegger, Big Bear Solar Observatory ; Update of BBSO version. ; 2000-03-31: Michael Steinegger, BBSO/NJIT ; Only basic GUI for Kanzelhoehe Solar Observatory. ; 2000-04-19: Michael Steinegger, BBSO/NJIT ; Output of progress report to text widget. ; 2000-05-23, Michael Steinegger, BBSO/NJIT; ; The center and radius of the solar disk is calculated with an ; improved CENTER_SOBEL.PRO, thus making CENTER_LIMB_COMP.PRO, ; CENTER_LIMB_BOX.PRO, and CENTER_ABS_DIFF.PRO obsolete. ; 2000-05-25, Michael Steinegger, BBSO/NJIT ; - Corrected bug in calculation of residual image (normalization of ; image and limb image) ; - Included p.int_i (disk center intensity after correcting for DC ; and FF) and p.int_l (disk center intensity of limb image) into ; P structure ; ;- start = SYSTIME( 1 ) ;----- definition of various parameters ;----- BEGIN CHANGE ----- ;ccd = { CCD, $ ; CAM: 'KX4', $ ; DIR: '/data/daytime/synoptic/', $ ; ARC: '/data/daytime/archiv/', $ ; WWW: '/data/daytime/www/', $ ; FTP: '/data/daytime/ftp/', $ ; TMP: '/tmp/halpha_tmp/', $ ; FDR: '', $ ; RED: 8 } ;----- END CHANGE ----- ;----- for testing: ccd = { CCD, $ CAM: 'KX4', $ DIR: '/home/sunset/michael/halpha/test/synoptic/', $ ARC: '/home/sunset/michael/halpha/test/archive/', $ WWW: '/home/sunset/michael/halpha/test/www/', $ FTP: '/home/sunset/michael/halpha/test/ftp/', $ TMP: '/home/sunset/michael/halpha/test/tmp/', $ FDR: '', $ RED: 8 } ;----- set window for display WIDGET_CONTROL, wid.d1, GET_VALUE = index WSET, index ERASE ;----- date day = { CCYY: date( 0 ), MM: date( 1 ), DD: date( 2 ) } p = { NX: 0, NXX: 0, NY: 0, NYY: 0, N: 0, XC: 0, YC: 0, XD: 0, YD: 0, $ INT: 0l, INT_I: 0l, INT_L: 0l } month = [ 'January', 'February', 'March', 'April', 'May', 'June', 'July', $ 'August', 'September', 'October', 'November', 'December' ] month = month( date( 1 ) - 1 ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [' Calculate flat field for ' + $ month + ' ' + STRCOMPRESS( STRING( date( 2 ) ), /REMOVE_ALL ) + ', ' + $ STRCOMPRESS( STRING( date( 0 ) ), /REMOVE_ALL ), '' ] ;----- create dark file name IF ccd.fdr EQ '' THEN dummyfdr = 'h' ELSE dummyfdr = ccd.fdr CASE day.mm OF 12: fn = STRMID( dummyfdr, 0, 1 ) + 'c' + STRING( day.dd, $ FORMAT = '(I2.2)' ) 11: fn = STRMID( dummyfdr, 0, 1 ) + 'b' + STRING( day.dd, $ FORMAT = '(I2.2)' ) 10: fn = STRMID( dummyfdr, 0, 1 ) + 'a' + STRING( day.dd, $ FORMAT = '(I2.2)' ) ELSE: fn = STRMID( dummyfdr, 0, 1 ) + STRTRIM( day.mm, 2 ) + $ STRING( day.dd, FORMAT = '(I2.2)' ) ENDCASE file = ccd.dir + fn + 'd.fts' ;----- check if dark file exists check = FINDFILE( file, COUNT = count ) ;----- read dark frame IF count GT 0 THEN BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [' Read dark frame: '$ + file,''] dark = FIX( READFITS ( file, dhdr, /SILENT ) ) TVSCL, CONGRID( dark, 256, 256 ), 0 ENDIF ELSE BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' No dark frame found: ' + file, '',$ ' Terminated!!!', '', '', '' ] WSET, index READ_JPEG, 'images/bbso.jpg', img TV, img, TRUE = 1 RETURN ENDELSE ;----- create image file name file = ccd.dir + fn + 'l.fts' ;----- check if image file exists check = FINDFILE( file, COUNT = count ) ;----- read image frame IF count GT 0 THEN BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [' Read image frame: '$ + file,''] img = ( READFITS( file, ihdr, /SILENT ) - dark ) > 0 ENDIF ELSE BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' No image frame found: ' + file, '', $ ' Terminated!!!', '', '', '' ] WSET, index READ_JPEG, 'images/bbso.jpg', img TV, img, TRUE = 1 RETURN ENDELSE ;----- image size p.nx = SXPAR( ihdr, 'NAXIS1' ) p.nxx = LONG( ROUND( p.nx / FLOAT( ccd.red ) ) ) p.ny = SXPAR( ihdr, 'NAXIS2' ) p.nyy = LONG( ROUND( p.ny / FLOAT( ccd.red ) ) ) p.xd = 1770 ; starting value p.yd = p.xd ;----- diameter and center coordinates tmp = CENTER_SOBEL( img, p, ccd ) p.xc = tmp( 0 ) p.yc = tmp( 1 ) p.xd = tmp( 2 ) p.yd = tmp( 3 ) tvfak=p.nx/256. TVSCL, CONGRID( img, 256, 256 ), 1 TVCIRCLE,tmp(2)/tvfak/2., 256+tmp(0)/tvfak, 256+tmp(1)/tvfak WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING ( [tmp(2),tmp(3)], FORMAT = $ '( " Disk diameter:", 2(I6) )' ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING ( [tmp(0),tmp(1)], FORMAT = $ '( " Disk center :", 2(I6) )' ) img_c = img ( p.xc - 50 : p.xc + 50, p.yc - 50 : p.yc + 50 ) ;----- disk center brightness (for calculating flat field) p.int = MEDIAN( img( p.xc - 30 : p.xc + 30, p.yc - 30 : p.yc + 30 ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Disk center brightness: ' + STRMID ( p.int, 2 ) + $ ' (for flat field)', '' ] ;----- create flat field file list SPAWN, 'ls -1 ' + ccd.dir + fn + 'l??.fts', file pos = STRPOS( file, '.fts' ) wo = WHERE( pos NE -1 ) IF wo( 0 ) EQ -1 THEN BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' No flat field frames found. ', '', $ ' Terminated!!!', '', '', '' ] WSET, index READ_JPEG, 'images/bbso.jpg', img TV, img, TRUE = 1 RETURN ENDIF ELSE BEGIN file = file( wo ) p.n = SIZE( file, /N_ELEMENTS ) + 1 WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Number of flat field frames: ' + STRTRIM( p.n-1, 2 ), '' ] ENDELSE ;----- read flat field frames flat = INTARR ( p.nxx, p.nyy, p.n ) flat( *, *, 0 ) = CONGRID( img, p.nxx, p.nyy, /INTERP ) disp = INTARR ( 2, p.n ) disp( *, 0 ) = [ p.xc, p.yc ] FOR i = 0, p.n - 2 DO BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Read flat field frame: ' + file( i ), ''] tmp = ( READFITS ( file( i ), fhdr, /SILENT ) - dark ) > 0 flat ( *, *, i + 1 ) = CONGRID ( tmp, p.nxx, p.nyy, /INTERP ) ;----- center coordinates cc = CENTER_SOBEL( tmp, p, ccd ) TVSCL, CONGRID( tmp, 256, 256 ), 1 ;; TVCIRCLE,cc(2)/tvfak/2., 256+cc(0)/tvfak, 256+cc(1)/tvfak ;; TVSCL, CONGRID( dark, 256, 256 ), 0 WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ STRING ( cc(2:3), FORMAT = '( " Diameter :", 2(I6) )' ) , $ STRING ( cc(0:1), FORMAT = '( " Disk center :", 2(I6) )' ) ] cc_shift = [ cc( 0 ) - p.xc, cc( 1 ) - p.yc ] WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ STRING ( cc_shift, FORMAT = '( " Disk shift :", 2(I6) )' ) ] ;----- cross correlation of center disp( *, i + 1 ) = cc( 0 : 1 ) flat_c = tmp( disp( 0, i + 1 ) - 50 : disp( 0, i + 1 ) + 50, $ disp( 1, i + 1 ) - 50 : disp( 1, i + 1 ) + 50 ) tmp = ALIGN( img_c, flat_c ) ;----- further improvement and conversion to displacement array ;; disp( *, i + 1 ) = - FIX( ROUND( ( disp( *, i + 1 ) - tmp - $ ;; disp( *, 0 ) ) / FLOAT( ccd.red ) ) ) disp(*, i + 1 ) = ( disp( *, 0 ) - disp( *, i + 1 ) - tmp ) disp(*, i + 1 ) = disp( * , i + 1 ) / FLOAT( ccd.red ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ STRING ( disp( *, i + 1 ) * ccd.red, FORMAT = $ '( " Displacement:", 2(I6), " (original image)" )' ) ] WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ STRING ( disp( *, i + 1 ), FORMAT = $ '( " Displacement:", 2(I6), " (resized image)" )' ), '' ] ENDFOR disp( *, 0 ) = disp( *, 0 ) * 0 ;----- image statistics WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [ '', $ ' Statistics: min max mean stdev', ''] WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING( $ FORMAT= '(" Dark frame ", 2( I8 ), 2( F11.2 ))', MIN( dark ), $ MAX( dark ), MEAN( dark ), STDEV( dark ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING( $ FORMAT= '(" Image frame ", 2( I8 ), 2( F11.2 ) )', MIN( img ), $ MAX( img ), MEAN( img ), STDEV( img ) ) FOR i = 0, p.n - 2 DO WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING( $ FORMAT= '(" Flat frame ", I1, 2( I8 ), 2( F11.2 ) )', i + 1, $ MIN( flat( *, *, i ) ), MAX( flat( *, *, i ) ), $ MEAN( flat( *, *, i) ), STDEV( flat( *, *, i ) ) ) ;----- Kuhn-Lin flat field WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ '', ' Apply Kuhn-Lin algorithm.', '' ] ;;stop,'FLAT' flat = FLAT_KUHN_LIN( flat, disp, p ) ;----- extrapolate missing flat field values and resize WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Extrapolate missing flat field values.', '' ] flat = FLAT_CLEAN( flat, [ p.xc, p.yc ] / FLOAT( ccd.red ), p ) ;----- flat field image WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Apply flat field and normalize image frame.', '' ] mean_flat = MEDIAN ( flat ) flat = TEMPORARY ( flat ) / mean_flat img = img / flat ;----- disk center brightness (for normalizing image) p.int_i = MEDIAN( img( p.xc - 30 : p.xc + 30, p.yc - 30 : p.yc + 30 ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Disk center brightness: ' + STRMID ( p.int_i, 2 ) + $ ' (image)', '' ] ;----- normalize image img = img / FLOAT( p.int_i ) * 10000. ;----- quick and dirty fix!!!!! img( *, 2030 ) = ( img( *, 2029 ) + img( *, 2031 ) ) / 2. flat = FIX( ROUND( flat * 10000. ) ) TVSCL, CONGRID( flat, 256, 256 ), 1 tmp = CONGRID( img, 256, 256 ) lim = 1000 TVSCL, tmp * ( tmp LE lim ) < lim , 2 TVSCL, tmp, 3 ;----- limb darkening profile WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Calculate limb image.', '' ] limb = RESIDUAL_LIMB( img, p, 60, 60, prof ) ;----- disk center brightness (limb image) p.int_l = MEDIAN( limb( p.xc - 30 : p.xc + 30, p.yc - 30 : p.yc + 30 ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Disk center brightness: ' + STRMID ( p.int_l, 2 ) + $ ' (limb image)', '' ] ;----- normalize limb image limb = limb / FLOAT( p.int_l ) * 10000. ;----- calculate residual image WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Calculate residual image.', '' ] res = img - limb ;----- convert images to integer img = FIX( ROUND( img ) ) limb = FIX( ROUND( limb ) ) res = FIX( ROUND( res ) ) TVSCL, CONGRID( limb, 256, 256 ), 4 TV, BYTSCL( CONGRID( res, 256, 256 ), MIN = -lim, MAX = lim ), 5 ;----- image statistics WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [ $ ' Statistics: min max mean stdev', '' ] WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING( $ FORMAT= '(" Flat field ", 2( I8 ), 2( F11.2 ) )', $ MIN( flat ), MAX( flat ), MEAN( flat ), STDEV( flat ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING( $ FORMAT= '(" Corrected image ", 2( I8 ), 2( F11.2 ) )', $ MIN( img ), MAX( img ), MEAN( img ), STDEV( img ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = STRING( $ FORMAT= '(" Limb image ", 2( I8 ), 2( F11.2 ) )', $ MIN( limb ), MAX( limb ), MEAN( limb ), STDEV( limb ) ) WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [ STRING( $ FORMAT= '(" Residual image ", 2( I8 ), 2( F11.2 ) )', $ MIN (res ), MAX( res ), MEAN( res ), STDEV( res ) ), '' ] ;----- clean temporary directory WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Clean temporary directory ' + ccd.tmp + '.', '' ] SPAWN, 'rm -f ' + ccd.tmp + '*', dummy ;----- write JPG's to temporary directory for inspecting the data files = [ ccd.tmp + fn + 'd.jpg', $ ccd.tmp + fn + 'f.jpg', $ ccd.tmp + fn + 'l.jpg', $ ccd.tmp + fn + 'p.jpg', $ ccd.tmp + fn + 'r.jpg' ] WRITE_JPEG, files( 0 ), BYTSCL( dark ) WRITE_JPEG, files( 1 ), BYTSCL( flat ) WRITE_JPEG, files( 2 ), BYTSCL( img ) WRITE_JPEG, files( 3 ), BYTSCL( limb ) WRITE_JPEG, files( 4 ), BYTSCL( res ) ;----- are the images OK? WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Inspect data - accept or reject them' ] INSPECT, wid.d1, files, flag IF flag EQ 'No' THEN BEGIN WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [ '', $ ' DATA NOT ACCEPTED', ' ', $ ' Done!!! CPU Time: ' + $ STRCOMPRESS( STRING( SYSTIME( 1 ) - start ), /REMOVE_ALL), ' ' ] RETURN ENDIF WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE=[ '', ' DATA ACCEPTED', '' ] WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = $ [ ' Write images to archive directories.' ] ;----- write dark frame CASE day.mm OF 12: fn = STRMID( dummyfdr, 0, 1 ) + 'dc' + STRING( day.dd, $ FORMAT = '(I2.2)' ) + STRING( FORMAT = '(I2.2)', $ day.ccyy mod 100 ) 11: fn = STRMID( dummyfdr, 0, 1 ) + 'db' + STRING( day.dd, $ FORMAT = '(I2.2)' ) + STRING( FORMAT = '(I2.2)', $ day.ccyy mod 100 ) 10: fn = STRMID( dummyfdr, 0, 1 ) + 'da' + STRING( day.dd, $ FORMAT = '(I2.2)' ) + STRING( FORMAT = '(I2.2)', $ day.ccyy mod 100 ) ELSE: fn = STRMID( dummyfdr, 0, 1 ) + 'd' + STRTRIM( day.mm, 2 ) + $ STRING( day.dd, FORMAT = '(I2.2)' ) + STRING( FORMAT = '(I2.2)', $ day.ccyy mod 100 ) ENDCASE SXDELPAR, dhdr, [ 'O_BZERO', 'O_BSCALE' ] mini = MIN( dark, MAX = maxi ) WIDGET_CONTROL, wid.t1, /APPEND, $ SET_VALUE = ' Dark frame: '+ccd.arc + ccd.fdr + fn + 'd.fts' WRITEFITS, ccd.arc + ccd.fdr + fn + 'd.fts', dark, dhdr ;----- write flat frame SXDELPAR, fhdr, [ 'O_BZERO', 'O_BSCALE' ] SXADDPAR, fhdr, 'ASP', FLOAT( p.xd ) / p.yd, ' Raw image aspect ratio' SXADDPAR, fhdr, 'CENX', p.xc, ' Raw image disk center X' SXADDPAR, fhdr, 'CENY', p.yc, ' Raw image disk center Y' SXADDPAR, fhdr, 'MAXC', p.int_i, ' Quiet Sun Max Brightness' SXADDPAR, fhdr, 'WIDT', ( p.xd + p.yd ) / 2., ' Width of disk (pixels)' mini = MIN( flat, MAX = maxi ) WIDGET_CONTROL, wid.t1, /APPEND, $ SET_VALUE = ' Flat frame: '+ccd.arc + ccd.fdr + fn + 'f.fts' WRITEFITS, ccd.arc + ccd.fdr + fn + 'f.fts', flat, fhdr ;----- write image frame SXDELPAR, ihdr, [ 'O_BZERO', 'O_BSCALE' ] SXADDPAR, ihdr, 'ASP', FLOAT( p.xd ) / p.yd, ' Raw image aspect ratio' SXADDPAR, ihdr, 'CENX', p.xc, ' Raw image disk center X' SXADDPAR, ihdr, 'CENY', p.yc, ' Raw image disk center Y' SXADDPAR, ihdr, 'MAXC', p.int_i, ' Quiet Sun Max Brightness' SXADDPAR, ihdr, 'WIDT', ( p.xd + p.yd ) / 2., ' Width of disk (pixels)' mini = MIN( img, MAX = maxi ) WIDGET_CONTROL, wid.t1, /APPEND, $ SET_VALUE = ' Image frame: '+ccd.arc + ccd.fdr + fn + 'l.fts' WRITEFITS, ccd.arc + ccd.fdr + fn + 'l.fts', img, ihdr ;----- write limb frame mini = MIN( limb, MAX = maxi ) WIDGET_CONTROL, wid.t1, /APPEND, $ SET_VALUE = ' Limb frame: '+ccd.arc + ccd.fdr + fn + 'p.fts' WRITEFITS, ccd.arc + ccd.fdr + fn + 'p.fts', limb, ihdr ;----- write residual frame mini = MIN( res, MAX = maxi ) WIDGET_CONTROL, wid.t1, /APPEND, $ SET_VALUE = ' Residual frame: '+ccd.arc + ccd.fdr + fn + 'r.fts' WRITEFITS, ccd.arc + ccd.fdr + fn + 'r.fts', res, ihdr ;----- low resolution WWW and FTP images WIDGET_CONTROL, wid.t1, /APPEND, $ SET_VALUE = [ '', ' Write WWW and FTP images.', $ ' WWW: ' + ccd.www, $ ' FTP: ' + ccd.ftp + ccd.fdr ] img = BYTSCL( img ) IMG_ANNOTATE, ihdr, img, tmp, icon WRITE_JPEG, ccd.www + 'hfullb.jpg', img WRITE_JPEG, ccd.ftp + ccd.fdr + fn + 'l.jpg', img WRITE_JPEG, ccd.www + 'hfullb2.jpg', tmp WRITE_JPEG, ccd.www + 'thfullb.jpg', icon ;----- high resolution WWW and FTP images res = BYTSCL( res, MIN = -lim * 2, MAX = lim * 2 ) IMG_ANNOTATE, ihdr, res, tmp, icon WRITE_JPEG, ccd.www + 'hfull.jpg', res WRITE_JPEG, ccd.ftp + ccd.fdr + fn + 'r.jpg', res WRITE_JPEG, ccd.www + 'hfull2.jpg', tmp WRITE_JPEG, ccd.www + 'thfull.jpg', icon OPENW, 1, ccd.www + 'hfull.txt' WRITEU, 1, ihdr CLOSE, 1 ;----- show the KSO image to indicate that we are done WSET, index READ_JPEG, 'kso.jpg', img TV, img, TRUE = 1 ;----- how long did we have to wait? WIDGET_CONTROL, wid.t1, /APPEND, SET_VALUE = [ '', $ ' Done!!! CPU Time: ' + $ STRCOMPRESS( STRING( SYSTIME( 1 ) - start ) ,/REMOVE_ALL ), ' ' ] RETURN END