;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; CALIB5.PRO ; ; Upper level routines ; Stat ; Pro EXTRACT_IMA2, iin, hin, x1, x2, y1, y2, iout, hout ; ; extracts a subimage ; Pro STAT_2D_FRM, ima, kx, ky, imb, imc ;Gives local stats over all ; ;image ; Pro STAT_IMA, ima, x1,y1,x2,y2,z ;gives stas in a ROI ; Function MIN_2D_FRM, ima, kx,ky ; Function STATIMA, ima, x1,y1,x2,y2 ; ; ; Visu ; ; Pro W512, n ;Creates a 512*512 display ; Pro VISU_IMA, ima_name, hima, ima, kx, ky, lcut, hcut ;Visualizes an image ; Function LOAD_IMA, ima, lcut, hcut, kx, ky ;Visualizes a loaded ima; ; ; Calib. processing ; ; Pro VISU_CAL,ima_name, iout, hout ;Gets a CAL ima, rectifies ; and visu. it ; Pro VISU_CAL_CLEAN, ima_name, backg, iout, hout ;Gets a CAL ima, rectifies ; subtracts and visu. it ; Pro READ_CAL,ima_name, itest, iout, hout ;Gets a CAL ima. rectified ; Pro CLEAN_CAL, ima, hima, itest, iout, hout ;rectifies a CAL image ; Function LOAD_CAL(ima,hima,lcut,hcut,itest,hout) ;rectifies a CAL image and ; visu. it ; Pro SET_CAL_HDR, hdr, refpix_x, refpix_y ;Sets cal parameters ; ; Catalogs of images ; ; Pro DARK_CATA ; (CATA) ; Pro SHOW_CATALOG ; (CATA) ; Pro CHOOSE_DARK, dark_new_name, drk, hdrk ; (CATA) ; Pro PRO_CAL, ima_name, drk, hdrk, ima, hima ;process a CAL with ; catalogued darks (CATA) ; Pro GET_DRK_NAME, ima_name, ass_name ; (CATA) ; ; Pro SET_CATALOG, template, db_ima, nima, ima_name ; Pro FIND_IMA, hdr, ima_db, ima_name ; Pro IMA_LIST, template, ima_db, nfiles ; Function DEFINE_CATALOG( nfiles ) ; ; Basic I/O ; ; Pro WRITE_IMA, ima_name, ima, hdr ;Stores an image and a hdr ; Pro SHOW_HDR, ima_hdr, FULL = I ;Shows some hdr parameters ; Pro COPY_IMA_HDR, hdr_in, hdr_out ;Copies a header ; Function READ_IMA( ima_name, hdr, ichoice ) ;opens an image from stor. ; ; Low level routines ; ; Function GETTOK(st,char) ; Function DATE_CAL( date, hour ) ; Pro DATE_NUM_TEXT,year,month,day,hour ; Function DEFINE_IMA_HDR( dummy ) ; Function DEFINE_CAL_HDR( dummy ) ; Function DEFINE_BSC_HDR( dummy ) ; Function DEFINE_C1_HDR( dummy ) ; Function DEFINE_CCD_HDR( dummy ) ; Function READ_IMA_HDR( ima_name, hdr, itest ) ; Function READ_IMA_FRAME( ima_name, bitpix, nx, ny ) ; Pro WRITE_HDR,ima_name, hdr ; Pro CHECK_IMGDIR, dummy ; Pro CHECK_FILENAME, filename, path, extension ; ; A.LL. ;----------------------------------------------------------------------------- ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: ; GETTOK ; PURPOSE: ; Function to retrieve the first part of the string ; until the character char is encountered. ; ; CALLING SEQUENCE: ; token = gettok( st, char ) ; ; INPUT: ; char - character separating tokens, scalar string ; ; INPUT-OUTPUT: ; st - (scalar) string to get token from (on output token is removed) ; ; OUTPUT: ; token - scalar string value is returned ; ; EXAMPLE: ; If ST is 'abc=999' then gettok(ST,'=') would return ; 'abc' and ST would be left as '999' ; ; HISTORY ; version 1 by D. Lindler APR,86 ; Remove leading blanks W. Landsman (from JKF) Aug. 1991 ;---------------------------------------------------------------------- function gettok,st,char ; On_error,2 ;Return to caller ; ; if char is a blank treat tabs as blanks ; tab=' ' while strpos(st,tab) GE 0 do begin ;Search for tabs pos=strpos(st,tab) strput,st,' ',pos end st = strtrim(st,1) ;Remove leading blanks ; ; find character in string ; pos = strpos(st,char) if pos EQ -1 then begin ;char not found? token = st st = '' return,token endif ; ; extract token ; token=strmid(st,0,pos) len=strlen(st) if pos EQ (len-1) then st='' else st=strmid(st,pos+1,len-pos-1) ; ; Return the result. ; return,token end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: ; DATE_CAL ; PURPOSE: ; Procedure to perform conversion of dates to decimal form ; ; format: string (ascii text) encoded as ; DD MON YEAR for date ; HH:MM:SS.SS for hour ; (eg. 14 JUL 1987 15:25:44.23) ; ; CALLING SEQUENCE ; jt = DATE_CAL( DATE, HOUR ) ; ; INPUTS: ; DATE - input date in one of the three possible formats ; OUTPUTS: ; The converted date is returned as the function value. ; HISTORY: ; version 1 D. Lindler July, 1987 ; adapted for IDL version 2 J. Isensee May, 1990 ; adapted from DATE_CONV to lasco use A.LL. ;----------------------------------------------------------------------- function date_cal, date, hour ; ; data declaration ; days = [0,31,28,31,30,31,30,31,31,30,31,30,31] months = [' ','JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT',$ 'NOV','DEC'] ; ; set default type if not supplied ; if n_params(0) lt 2 then type = 'REAL' ; ; Determine type of input supplied ; s = size(date) & ndim = s(0) & datatype = s(ndim+1) if ndim gt 0 then begin if ndim gt 1 then goto,notvalid if datatype ne 7 then goto,notvalid endif ;s = size(hour) & ndim = s(0) & datatype = s(ndim+1) if ndim gt 0 then begin if ndim gt 1 then goto,notvalid if datatype ne 7 then goto,notvalid endif ; ;*** Convert input to year,day,hour,minute,second ; islash = strpos(date,'/') itarget = strpos(date,'-') iblank = strpos(date,' ') if islash gt -1 then begin temp = date+'/' day_of_month = fix(gettok(temp,'/')) month_name = gettok(temp,'/') year = fix(gettok(temp,'/')) endif else begin if itarget gt -1 then begin temp = date+'-' day_of_month = fix(gettok(temp,'-')) month_name = gettok(temp,'-') year = fix(gettok(temp,'-')) endif else begin if iblank gt -1 then begin temp = date+' ' day_of_month = fix(gettok(temp,' ')) month_name = gettok(temp,' ') year = fix(gettok(temp,' ')) endif else begin text = date+' bad separator for date!' message, text endelse endelse endelse temp = hour hour = fix(gettok(temp,':')) minute = fix(gettok(temp,':')) sec = double(strtrim(strmid(temp,0,5))) ; ; convert to day of year from month/day_of_month ; ; correction for leap years ; if (fix(year) mod 4) eq 0 then days(2) = 29 ;add one to ; february ; determine month number ; month_name = strupcase(month_name) month_str = BYTE(month_name) ipos = WHERE( month_str ge 48 and month_str le 57) if n_elements(month_str) eq n_elements(ipos) then begin mon = fix(month_name) if mon le 12 and mon gt 0 then goto, found endif else begin for mon = 1,12 do begin if month_name eq months(mon) then goto,found end endelse text = month_name+' invalid month name specified' message, text retall found: ; ; compute day of year ; day = fix(total(days(0:mon-1))+day_of_month) ; ;*** Now convert to output format ; if year gt 1900 then year = year-1900 out = sec/86400.0d0 $ + double(minute)/1440.0d0 $ + double(hour)/24.0d0 $ + double( day) $ + double(year)*1000d0 return,out ; ; invalid input date error section ; notvalid: text = STRING(date)+STRIN(hour)+' invalid date input specified' message, text retall end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: DATE_NUM_TEXT.PRO ; PURPOSE: Gives a set of date strings, ex: 12, 09, 1994 (for the 12 Sep 1994) ; A.LL. ;----------------------------------------------------------------------------- Pro DATE_NUM_TEXT,year,month,day,hour months = [' ','JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT',$ 'NOV','DEC'] ; tim = SYSTIME(0) day = STRMID(tim,8,2) month_name = STRUPCASE(STRMID(tim,4,3)) year = STRMID(tim,20,4) hour = STRMID(tim,11,8) ; month_name = strupcase(month_name) for mon = 1,12 do begin if month_name eq months(mon) then goto,found end text = month_name+' invalid month name specified' message, text retall found: month = STRING(FORMAT='(I2.2)',mon) ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: ; check_filename ; PURPOSE: ; Removes the extension and path from the filename ; if present ; ; CALLING SEQUENCE: ; check_filename,filename ; check_filename,filename,path,extension ; ; INPUTS: ; filename = string to be checked (may be a string array) ; ; OUTPUTS: ; filename will be returned without extension and path ; ; OPTIONAL OUTPUTS: ; path = path name ; extension = extension not including decimal point ; ; MODIFICATION HISTORY: ; RAH 10/1/89 ; rah 3/28/91 added array input for filename ; ALL 5/15/93 adapted to VMS ; SCCS variables for IDL use ; ; @(#)check_filename.pro 1.1 7/6/92 :NRL Solar Physics ; ;------------------------------------------------------------------------------ pro check_filename,filename,path,extension s = size(filename) n = n_elements(filename) if s(0) gt 0 then begin ; filename is an array p = strarr(n) f = filename ext = p for i=0,n-1 do begin slash=-1 repeat begin pos = slash+1 IF !VERSION.OS EQ 'vms' THEN BEGIN slash = strpos (filename(i) , ']',pos) ; A.LL VMS ADAPTED ENDIF ELSE BEGIN slash = strpos (filename(i) , '/',pos) ENDELSE endrep until slash eq -1 if (pos gt 0) then begin p(i) = strmid(filename(i),0,pos) f(i) = strmid(filename(i),pos,strlen(filename(i))) endif else p(i)='' decimalpt=strpos(f(i), '.') if (decimalpt ne (-1)) then begin ext(i) = strmid(f(i),decimalpt+1,strlen(f(i))) f(i)=strmid(f(i),0,decimalpt) IF !VERSION.OS EQ 'vms' THEN BEGIN ; remove version number lastdecimal = strpos (ext(i), '.') ; A.LL VMS ADAPTED if lastdecimal eq (-1) then $ lastdecimal = strpos (ext(i), ';') if lastdecimal ne (-1) then $ ext(i) = strmid(ext(i),0,lastdecimal) ENDIF endif else ext(i)='' endfor filename = f endif else begin ; filename is a scalar slash=-1 repeat begin pos = slash+1 IF !VERSION.OS EQ 'vms' THEN BEGIN slash = strpos (filename , ']',pos) ; A.LL VMS ADAPTED ENDIF ELSE BEGIN slash = strpos (filename , '/',pos) ENDELSE endrep until slash eq -1 if (pos gt 0) then begin p = strmid(filename,0,pos) filename = strmid(filename,pos,strlen(filename)) endif else p='' decimalpt=strpos(filename, '.') if (decimalpt ne (-1)) then begin ext = strmid(filename,decimalpt+1,strlen(filename)) filename=strmid(filename,0,decimalpt) pos = decimalpt+1 IF !VERSION.OS EQ 'vms' THEN BEGIN ; remove version number lastdecimal = strpos (ext, '.') ; A.LL VMS ADAPTED if lastdecimal eq (-1) then $ lastdecimal = strpos (ext, ';') if lastdecimal ne (-1) then $ ext = strmid(ext,0,lastdecimal) ENDIF endif else ext='' endelse np = n_params(0) case np of 2: path=p 3: begin extension = ext path = p end else: p='' ;dummy statement endcase return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: ; check_imgdir ; PURPOSE: ; checks !imgdir for a / on the end ; CALLING SEQUENCE: ; check_imgdir ; ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; ; PROCEDURE: ; if !imgdir does not end with / then puts one on ; ; MODIFICATION HISTORY: RAH 3/26/91 ; ALL 5/15/93 adapted to VAX VMS ; SCCS variables for IDL use ; ; @(#)check_imgdir.pro 1.1 7/6/92 :NRL Solar Physics ; ;----------------------------------------------------------------------------- pro check_imgdir,dummy ; IF !imgdir NE '' THEN BEGIN IF !VERSION.OS EQ 'vms' THEN BEGIN if strmid(!imgdir,strlen(!imgdir)-1,1) ne ']' then !imgdir=!imgdir+']' i = strpos(!imgdir,'[') if (i eq -1) then !imgdir='['+!imgdir ENDIF ELSE BEGIN if strmid(!imgdir,strlen(!imgdir)-1,1) ne '/' then !imgdir=!imgdir+'/' ENDELSE ENDIF return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: define_ima_hdr ; PURPOSE: defines a image header structure ; CATEGORY: BASIC_INTERFACES ; CALLING SEQUENCE: hdr = define_ima_hdr(0) ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: structure array containing initialized an header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: RAH 10/1/89 ; RAH 8/20/91 Added AES BSBD camera keywords ; ALL 04/27/93 takes only standard KEYWORDS ; ; SCCS variables for IDL use ; ; @(#)define_ima_hdr.pro 1.1 7/6/92 :NRL Solar Physics ; ;;;common ccd_header,header,nt,tags ;----------------------------------------------------------------------------- Function define_ima_hdr, dummy ; int=0 lon=0L flt=0. str='' sta=replicate(str,20) a={IMA_HEADER, $ FILENAME:str, $ ;Filename of image data FILEORIG:str, $ ;Original filename as collected DEVTYPE :str, $ ;Device type, eg. TK1024 SERIALN :str, $ ;Device serial number BITPIX :int, $ ;Number of bits per pixel (multiple of 8) NAXIS :int, $ ;Number of axes in array NAXIS1 :int, $ ;Number of pixels in fastest ranging axis NAXIS2 :int, $ ;Number of pixels in second fastest ranging axis NAXIS3 :int, $ ;Number of pixels in third fastest ranging axis NAXIS4 :int, $ ;Number of pixels in fourth fastest ranging axis BSCALE :flt, $ ;Scale factor (true=value*bscale+bzero) BZERO :flt, $ ;Offset applied to true pixel values BUNIT :str, $ ;Brightness units DATE :str, $ ;Date File written (dd/mm/yy) DATE_OBS:str, $ ;Starting date of data acquisition TIME_OBS:str, $ ;Starting time of data acquisition EXPTIME :flt, $ ;Exposure time (seconds) EXPMODE :flt, $ ;Exposure mode OBJECT :str, $ ;Image object ("flat field","resolution target") INSTRUME:str, $ ;Data acquisition camera system TELESCOP:str, $ ;Data acquisition telescope (C1, etc, EIT, TEST) BLANK :int, $ ;Undefined pixels set to this value CTYPE1 :str, $ ;Type of physical coordinate on axis 1 CRVAL1 :flt, $ ;Value of physical coord. axis 1 at ref pixel CRPIX1 :flt, $ ;Array location of reference pixel along axis 1 CDELT1 :flt, $ ;Increment in physical coordinate along axis 1 CTYPE2 :str, $ ;Type of physical coordinate on axis 2 CRVAL2 :flt, $ ;Value of physical coord. axis 2 at ref pixel CRPIX2 :flt, $ ;Array location of reference pixel along axis 2 CDELT2 :flt, $ ;Increment in physical coordinate along axis 2 CTYPE3 :str, $ ;Type of physical coordinate on axis 3 CRVAL3 :flt, $ ;Value of physical coord. axis 3 at ref pixel CRPIX3 :flt, $ ;Array location of reference pixel along axis 3 CDELT3 :flt, $ ;Increment in physical coordinate along axis 3 CTYPE4 :str, $ ;Type of physical coordinate on axis 4 CRVAL4 :flt, $ ;Value of physical coord. axis 4 at ref pixel CRPIX4 :flt, $ ;Array location of reference pixel along axis 4 CDELT4 :flt, $ ;Increment in physical coordinate along axis 4 PCOL :int, $ ;Col. of image point closest to the readout PROW :int, $ ;Row. of image point closest to the readout SUMCOL :int, $ ;Number of columns summed together SUMROW :int, $ ;Number of rows summed together DATAMAX :lon, $ ;Maximun data value in the image DATAMIN :lon, $ ;Minimun (non-zero) data value in the image ; DARKFILE:str, $ ;Associated Dark file TEMP_CCD:flt, $ COMMENT :sta, $ ;Comment HISTORY :sta} ;Comments of processing history return, a end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: define_C1_Hdr ; PURPOSE: defines the C1 (PF) header structure ; CATEGORY: General tools Low level routine ; CALLING SEQUENCE: h=define_C1_hdr (0) ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: h struct. array containing initialized an header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: none ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: define_ccd_hdr RAH 10/1/89 ; RAH 8/20/91 define_ccd_hdr Added AES BSBD camera keywords ; ALL 6/24/93 Remove common, changes to define_C1_hdr ; ; SCCS variables for IDL use ; ; @(#)define_c1_hdr.pro 1.1 7/6/92 :NRL Solar Physics ; ;----------------------------------------------------------------------------- Function define_C1_hdr, dummy ; int=0 lon=0L flt=0. str='' dbl=0.D0 sta=replicate(str,20) ; ; BITPIX B_unit C_type_1,2 Codes ; CCD TEST BDBD, BSBD 16 ADU pixel BD, BS ; Acquisit C1,C2,C3 16 ADU pixel Ax, ; FP Acquis AFP 16 ADU pixel AFP ; Calibrated C1,C2,C3 -32 p_events/s microns Cx, FP ; Processing C1,C2,C3 -32 photons arc_min FP ; Basic BC ; ; a={C1_HEADER, $ FILENAME:str, $ ; Ax AFP Cx FP BC :Filename of image data FILEORIG:str, $ ; Ax AFP Cx FP BC :Original filename as collected JT :dbl, $ ; Cx FP BC :Julian time for data collection BITPIX :int, $ ; Ax AFP Cx FP BC :Number of bits per pixel (multiple of 8) NAXIS :int, $ ; Ax AFP Cx FP BC :Number of axes in array NAXIS1 :int, $ ; Ax AFP Cx FP BC :Number of pixels in fastest ranging axis NAXIS2 :int, $ ; Ax AFP Cx FP BC :Number of pixels in second fastest ranging axis NAXIS3 :int, $ ; AFP FP :Number of pixels in third fastest ranging axis NAXIS4 :int, $ ; AFP FP :Number of pixels in fourth fastest ranging axis BSCALE :flt, $ ; Ax AFP Cx FP BC :Scale factor (true=value*bscale+bzero) BZERO :flt, $ ; Ax AFP Cx FP BC :Offset applied to true pixel values BUNIT :str, $ ; Ax AFP Cx FP BC :Brightness units DATE :str, $ ; Ax AFP Cx FP BC :Date File written (dd/mm/yy) TIME :str, $ ; Cx FP BC OBJECT :str, $ ; Ax AFP Cx FP BC :Image object ("flat fld", "resolution target") TELESCOP:str, $ ; Ax AFP Cx FP :Data acquisition telescope (C1, etc, EIT, TEST) BLANK :int, $ ; Ax AFP Cx FP BC :Undefined pixels set to this value CTYPE1 :str, $ ; Ax AFP Cx FP BC :Type of physical coordinate on axis 1 CRVAL1 :flt, $ ; Ax AFP Cx FP BC :Value of physical coord. axis 1 at ref pixel CRPIX1 :flt, $ ; Ax AFP Cx FP BC :Array location of reference pixel along axis 1 CDELT1 :flt, $ ; Ax AFP Cx FP BC :Increment in physical coordinate along axis 1 CROTA1 :flt, $ ; Cx FP BC : CTYPE2 :str, $ ; Ax AFP Cx FP BC :Type of physical coordinate on axis 2 CRVAL2 :flt, $ ; Ax AFP Cx FP BC :Value of physical coord. axis 2 at ref pixel CRPIX2 :flt, $ ; Ax AFP Cx FP BC :Array location of reference pixel along axis 2 CDELT2 :flt, $ ; Ax AFP Cx FP BC :Increment in physical coordinate along axis 2 CROTA2 :flt, $ ; Cx FP BC : CTYPE3 :str, $ ; AFP FP :Type of physical coordinate on axis 3 CRVAL3 :flt, $ ; AFP FP :Value of physical coord. axis 3 at ref pixel CRPIX3 :flt, $ ; AFP FP :Array location of reference pixel along axis 3 CDELT3 :flt, $ ; AFP FP :Increment in physical coordinate along axis 3 CTYPE4 :str, $ ; AFP FP :Type of physical coordinate on axis 4 CRVAL4 :flt, $ ; AFP FP :Value of physical coord. axis 4 at ref pixel CRPIX4 :flt, $ ; AFP FP :Array location of reference pixel along axis 4 CDELT4 :flt, $ ; AFP FP :Increment in physical coordinate along axis 4 PCOL :int, $ ; Ax AFP Cx FP :Col. of the img point closest to the readout or init img PROW :int, $ ; Ax AFP Cx FP :Row of the image point closest to the readout or init img SUMCOL :int, $ ; Ax AFP Cx FP :Number of columns summed together / initial img SUMROW :int, $ ; Ax AFP Cx FP :Number of rows summed together /initial img DATAMAX :lon, $ ; Ax AFP Cx FP BC :Maximum data value in the image DATAMIN :lon, $ ; Ax AFP Cx FP BC :Minimum (non-zero) data value COMMENT :sta, $ ; Ax AFP Cx FP BC :Comment HISTORY :sta} ; Ax AFP Cx FP BC :Comments of processing history return,a end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: define_cal_hdr ; PURPOSE: defines header structure for cal. images of C2 and C3 ; CATEGORY: General tools low level routines ; CALLING SEQUENCE: h=define_cal_hdr (0) ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: h struct. array containing initialized an header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: none ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: define_ccd_hdr RAH 10/1/89 ; RAH 8/20/91 define_ccd_hdr Added AES BSBD camera keywords ; ALL 6/24/93 Remove common, changes to define_cal_hdr ; ; SCCS variables for IDL use ; ; @(#)define_ccd_hdr.pro 1.1 7/6/92 :NRL Solar Physics ; ;----------------------------------------------------------------------------- Function define_cal_hdr, dummy ; int=0 lon=0L flt=0. str='' dbl=0.D0 sta=replicate(str,20) ; ; BITPIX B_unit C_type_1,2 Codes ; CCD TEST BDBD, BSBD 16 ADU pixel BD, BS ; Acquisit C1,C2,C3 16 ADU pixel Ax, ; FP Acquis AFP 16 ADU pixel AFP ; Calibrated C1,C2,C3 -32 p_events/s microns Cx, FP ; Processing C1,C2,C3 -32 photons arc_min FP ; Basic BC ; ; a={CAL_HEADER, $ FILENAME:str, $ ; Ax AFP Cx FP BC :Filename of image data FILEORIG:str, $ ; Ax AFP Cx FP BC :Original filename as collected JT :dbl, $ ; Cx FP BC :Julian time for data collection BITPIX :int, $ ; Ax AFP Cx FP BC :Number of bits per pixel (multiple of 8) NAXIS :int, $ ; Ax AFP Cx FP BC :Number of axes in array NAXIS1 :int, $ ; Ax AFP Cx FP BC :Number of pixels in fastest ranging axis NAXIS2 :int, $ ; Ax AFP Cx FP BC :Number of pixels in second fastest ranging axis BSCALE :flt, $ ; Ax AFP Cx FP BC :Scale factor (true=value*bscale+bzero) BZERO :flt, $ ; Ax AFP Cx FP BC :Offset applied to true pixel values BUNIT :str, $ ; Ax AFP Cx FP BC :Brightness units DATE :str, $ ; Ax AFP Cx FP BC :Date File written (dd/mm/yy) TIME :str, $ ; Cx FP BC OBJECT :str, $ ; Ax AFP Cx FP BC :Image object ("flat fld", "resolution target") TELESCOP:str, $ ; Ax AFP Cx FP :Data acquisition telescope (C1, etc, EIT, TEST) BLANK :int, $ ; Ax AFP Cx FP BC :Undefined pixels set to this value CTYPE1 :str, $ ; Ax AFP Cx FP BC :Type of physical coordinate on axis 1 CRVAL1 :flt, $ ; Ax AFP Cx FP BC :Value of physical coord. axis 1 at ref pixel CRPIX1 :flt, $ ; Ax AFP Cx FP BC :Array location of reference pixel along axis 1 CDELT1 :flt, $ ; Ax AFP Cx FP BC :Increment in physical coordinate along axis 1 CROTA1 :flt, $ ; Cx FP BC : CTYPE2 :str, $ ; Ax AFP Cx FP BC :Type of physical coordinate on axis 2 CRVAL2 :flt, $ ; Ax AFP Cx FP BC :Value of physical coord. axis 2 at ref pixel CRPIX2 :flt, $ ; Ax AFP Cx FP BC :Array location of reference pixel along axis 2 CDELT2 :flt, $ ; Ax AFP Cx FP BC :Increment in physical coordinate along axis 2 CROTA2 :flt, $ ; Cx FP BC : PCOL :int, $ ; Ax AFP Cx FP :Col. of the img point closest to the readout or init img PROW :int, $ ; Ax AFP Cx FP :Row of the image point closest to the readout or init img SUMCOL :int, $ ; Ax AFP Cx FP :Number of columns summed together / initial img SUMROW :int, $ ; Ax AFP Cx FP :Number of rows summed together /initial img DATAMAX :lon, $ ; Ax AFP Cx FP BC :Maximum data value in the image DATAMIN :lon, $ ; Ax AFP Cx FP BC :Minimum (non-zero) data value COMMENT :sta, $ ; Ax AFP Cx FP BC :Comment HISTORY :sta} ; Ax AFP Cx FP BC :Comments of processing history return,a end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: define_BSC_Hdr ; PURPOSE: defines the basic header structure for lasco images ; CATEGORY: General tools low level routine ; CALLING SEQUENCE: h=define_bsc_hdr (0) ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: struct. array containing initialized an header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: none ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: RAH 10/1/89 ; RAH 8/20/91 Added AES BSBD camera keywords ; ALL 6/24/93 Remove common, adapts for a basic set of KEYWORDS ; ; SCCS variables for IDL use ; ; @(#)define_bsc_hdr.pro 1.1 7/6/92 :NRL Solar Physics ; ;----------------------------------------------------------------------------- Function define_bsc_hdr, dummy ; int=0 lon=0L flt=0. str='' dbl=0.D0 sta=replicate(str,20) ; ; BITPIX B_unit C_type_1,2 Codes ; CCD TEST BDBD, BSBD 16 ADU pixel BD, BS ; Acquisit C1,C2,C3 16 ADU pixel Ax, ; FP Acquis AFP 16 ADU pixel AFP ; Calibrated C1,C2,C3 -32 p_events/s microns Cx, FP ; Processing C1,C2,C3 -32 photons arc_min FP ; Basic BC ; ; a={BASIC_HEADER, $ FILENAME:str, $ ; Ax AFP Cx FP BC :Filename of image data FILEORIG:str, $ ; Ax AFP Cx FP BC :Original filename as collected JT :dbl, $ ; Cx FP BC :Julian time for data collection BITPIX :int, $ ; Ax AFP Cx FP BC :Number of bits per pixel (multiple of 8) NAXIS :int, $ ; Ax AFP Cx FP BC :Number of axes in array NAXIS1 :int, $ ; Ax AFP Cx FP BC :Number of pixels in fastest ranging axis NAXIS2 :int, $ ; Ax AFP Cx FP BC :Number of pixels in second fastest ranging axis BSCALE :flt, $ ; Ax AFP Cx FP BC :Scale factor (true=value*bscale+bzero) BZERO :flt, $ ; Ax AFP Cx FP BC :Offset applied to true pixel values BUNIT :str, $ ; Ax AFP Cx FP BC :Brightness units DATE :str, $ ; Ax AFP Cx FP BC :Date File written (dd/mm/yy) TIME :str, $ ; Cx FP BC :Time File written (hh:mm:ss.dd) OBJECT :str, $ ; Ax AFP Cx FP BC :Image object ("flat fld", "resolution target") BLANK :int, $ ; Ax AFP Cx FP BC :Undefined pixels set to this value CTYPE1 :str, $ ; Ax AFP Cx FP BC :Type of physical coordinate on axis 1 CRVAL1 :flt, $ ; Ax AFP Cx FP BC :Value of physical coord. axis 1 at ref pixel CRPIX1 :flt, $ ; Ax AFP Cx FP BC :Array location of reference pixel along axis 1 CDELT1 :flt, $ ; Ax AFP Cx FP BC :Increment in physical coordinate along axis 1 CROTA1 :flt, $ ; Cx FP BC : CTYPE2 :str, $ ; Ax AFP Cx FP BC :Type of physical coordinate on axis 2 CRVAL2 :flt, $ ; Ax AFP Cx FP BC :Value of physical coord. axis 2 at ref pixel CRPIX2 :flt, $ ; Ax AFP Cx FP BC :Array location of reference pixel along axis 2 CDELT2 :flt, $ ; Ax AFP Cx FP BC :Increment in physical coordinate along axis 2 CROTA2 :flt, $ ; Cx FP BC : PCOL :int, $ ; Ax AFP Cx FP BC :Col. of the img point closest to the readout or init img PROW :int, $ ; Ax AFP Cx FP BC :Row of the image point closest to the readout or init img SUMCOL :int, $ ; Ax AFP Cx FP BC :Number of columns summed together / initial img SUMROW :int, $ ; Ax AFP Cx FP BC :Number of rows summed together /initial img DATAMAX :lon, $ ; Ax AFP Cx FP BC :Maximum data value in the image DATAMIN :lon, $ ; Ax AFP Cx FP BC :Minimum (non-zero) data value COMMENT :sta, $ ; Ax AFP Cx FP BC :Comment HISTORY :sta} ; Ax AFP Cx FP BC :Comments of processing history return,a end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: define_CCD_Hdr ; PURPOSE: defines the CCD header structure ; CATEGORY: CCD low level routine ; CALLING SEQUENCE: h=define_CCD_hdr (0) ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: struct. array containing initialized an header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: ccd_header,header,nt,tags ; header = the header structure ; nt = number of elements in the header ; tags = string array of names of header items ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: RAH 10/1/89 ; RAH 8/20/91 Added AES BSBD camera keywords ; ; SCCS variables for IDL use ; ; @(#)define_ccd_hdr.pro 1.1 7/6/92 :NRL Solar Physics ; ;--------------------------------------------------------------------------- pro define_ccd_hdr,hdr ; common ccd_header,header,nt,tags int=0 lon=0L flt=0. str='' sta=replicate(str,20) a={CCD_HEADER, $ FILENAME:str, $ ;Filename of image data FILEORIG:str, $ ;Original filename as collected DEVTYPE :str, $ ;Device type, eg. TK1024 SERIALN :str, $ ;Device serial number BITPIX :int, $ ;Number of bits per pixel (multiple of 8) NAXIS :int, $ ;Number of axes in array NAXIS1 :int, $ ;Number of pixels in fastest ranging axis NAXIS2 :int, $ ;Number of pixels in second fastest ranging axis NAXIS3 :int, $ ;Number of pixels in third fastest ranging axis NAXIS4 :int, $ ;Number of pixels in fourth fastest ranging axis BSCALE :flt, $ ;Scale factor (true=value*bscale+bzero) BZERO :flt, $ ;Offset applied to true pixel values BUNIT :str, $ ;Brightness units DATE :str, $ ;Date File written (dd/mm/yy) DATE_OBS:str, $ ;Starting date of data acquisition TIME_OBS:str, $ ;Starting time of data acquisition EXPTIME :flt, $ ;Exposure time (seconds) EXPMODE :flt, $ ;Exposure mode OBJECT :str, $ ;Image object ("flat fld", "resolution target") INSTRUME:str, $ ;Data acquisition camera system TELESCOP:str, $ ;Data acquisition telescope (C1, etc, EIT, TEST) BLANK :int, $ ;Undefined pixels set to this value CTYPE1 :str, $ ;Type of physical coordinate on axis 1 CRVAL1 :flt, $ ;Value of physical coord. axis 1 at ref pixel CRPIX1 :flt, $ ;Array location of reference pixel along axis 1 CDELT1 :flt, $ ;Increment in physical coordinate along axis 1 CTYPE2 :str, $ ;Type of physical coordinate on axis 2 CRVAL2 :flt, $ ;Value of physical coord. axis 2 at ref pixel CRPIX2 :flt, $ ;Array location of reference pixel along axis 2 CDELT2 :flt, $ ;Increment in physical coordinate along axis 2 CTYPE3 :str, $ ;Type of physical coordinate on axis 3 CRVAL3 :flt, $ ;Value of physical coord. axis 3 at ref pixel CRPIX3 :flt, $ ;Array location of reference pixel along axis 3 CDELT3 :flt, $ ;Increment in physical coordinate along axis 3 CTYPE4 :str, $ ;Type of physical coordinate on axis 4 CRVAL4 :flt, $ ;Value of physical coord. axis 4 at ref pixel CRPIX4 :flt, $ ;Array location of reference pixel along axis 4 CDELT4 :flt, $ ;Increment in physical coordinate along axis 4 PCOL :int, $ ;Col. of the image point closest to the readout PROW :int, $ ;Row of the image point closest to the readout SUMCOL :int, $ ;Number of columns summed together SUMROW :int, $ ;Number of rows summed together RUNMODE :str, $ ;Camera run mode: fast/slow clear NCLEARS :int, $ ;Number of clears per cycle AMP_POWR:str, $ ;Output Amplifier Power status: off/on PRE_AMP :str, $ ;Pre Amplifier Power status: off/on DATAMAX :lon, $ ;Maximum data value in the image DATAMIN :lon, $ ;Minimum (non-zero) data value READPORT:str, $ ;Designation of readout port (A,B,C,D) RECTIFY :int, $ ;Rectification parameter: 0=no 1=yes PROC_SPEED:str, $ ;Camera microprocessor speed, slow/fast VOD :flt, $ ;Voltage, Vod, of output drain VDD :flt, $ ;Voltage, Vdd VLASTG :flt, $ ;Voltage of last gate VRESET :flt, $ ;Voltage of reset gate VSUMWL :flt, $ ;Voltage of summing well low rail VSUMWH :flt, $ ;Voltage of summing well high rail VUPSERH :flt, $ ;Voltage of upper serial phases high rail VUPSERL :flt, $ ;Voltage of upper serial phases low rail VPARH :flt, $ ;Voltage of parallel phases high rail VPARL :flt, $ ;Voltage of parallel phases low rail VBOSERH:flt, $ ;Voltage of bottom serial phase high rail VBOSERL:flt, $ ;Voltage of bottom serial phase low rail VPAR3H :flt, $ ;Voltage of parallel phase 3 high rail VPAR3L :flt, $ ;Voltage of parallel phase 3 low rail VUPTRAH :flt, $ ;Voltage of upper transfer gate high rail VUPTRAL :flt, $ ;Voltage of upper transfer gate low rail VBOTRAH :flt, $ ;Voltage of bottom transfer gate high rail VBOTRAL :flt, $ ;Voltage of bottom transfer gate low rail VPLUS_5A:flt, $ ;Positive 5 volts, analog VPLUS_5D:flt, $ ;Positive 5 volts, digital VPLUS_10:flt, $ ;Positive 10 volts VNEG_15 :flt, $ ;Negative 15 volts VPLUS_15:flt, $ ;Positive 15 volts VPLUS_24:flt, $ ;Positive 24 volts RAIL_ADJST:lon, $ ;Rail adjust register, TG C/D, TG A/B, P3, P12 VRAIL_12:flt, $ ;Rail adjust level Parallel 12 VRAIL_3 : flt, $ ;Rail adjust level Parallel phase 3 VRAIL_TA: flt, $ ;Rail adjust level transfer gate A/B VRAIL_TC: flt, $ ;Rail adjust level transfer gate C/D FINGSET :int, $ ;Cold finger temperature set point TEMP :flt, $ ;Temperature TEMP_CCD:flt, $ ;Temperature of CCD TEMP_FNG:flt, $ ;Temperature of CCD Cold Finger COMMENT :sta, $ ;Comment HISTORY :sta} ;Comments of processing history nt=n_tags(a) tags=tag_names(a) header=a hdr = a return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: read_ima_hdr ; PURPOSE: function procedure to read header from disk file, f ; and store in a standard header structure type ; CATEGORY: BASIC_INTERFACES ; CALLING SEQUENCE: read_ima_hdr,ima_name,ima_header ; INPUTS: ima_name = string containing the header filename ; ima_header = structure ; verbose = 1, print all absent variables ; verbose = 0, print only a resumee ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: ima_header = header structure from disk ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: RAH 10/1/89, ACG 11/21/89, rah 1/9/91 ; rah 3/15/91 to account for unrecognized keyword ; rah 8/20/91 to trim leading and trailing blanks ; DW 8/27/91 change delimiter to '=' ; DW 2/26/93 put TEMP_FNG in TEMP as well ; All 4/25/93 for VMS image files in general ; Common supression ; SCCS variables for IDL use ; ; @(#)read_ima_header.pro 1.3 4/10/93 :NRL Solar Physics ; ;----------------------------------------------------------------------------- Function read_ima_hdr,ima_name,ima_header,verbose ; a=ima_header nt=n_tags(a) tags=tag_names(a) nun = 0 ; f=ima_name check_filename,f,path,extension check_imgdir ; NOTE: gestion des erreurs a rajouter ; Modif. A.LL 93/04/25 IF (!VERSION.OS NE 'vms') THEN $ openr,lu, path+f+'.hdr',error=err,/GET_LUN ELSE $ openr,lu, path+f+'.hdr',error=err,/GET_LUN,/STREAM ;Modif. A.LL 93/06/29 on_ioerror, eod ; point_lun,lu,0 if (verbose gt 0) then print, 'Readed header:',path+f+'.hdr' ; jcomment = -1 jhistory = -1 key='' eqs='' slash=byte('/') nun = 0 ; A.ll. 06/20/93 repeat begin ; by = '' IF (!VERSION.OS EQ 'vms') THEN BEGIN ; A.LL. 04/25/93 readf,lu,by,FORMAT='(A)' ENDIF ELSE BEGIN readf,lu,by ENDELSE ; print, by ; sp=strpos(by,'=') ;delimit keyword by '=' if(sp eq -1) then sp = strpos(by,' ');retain compat. with space delimiter key=strmid(by,0,sp) key=strcompress(key,REMOVE_ALL=1) ;remove whitespace from keyword 8/27/91 key = strupcase(key) i=where (key eq tags) ;find match of keyword with tagname if (n_elements(i) gt 0) then begin ;ignore unrecognized keywords 3/15/91 i = i(0) ;only take first occurence if (i ne -1) then begin s=size(a.(i)) ntype = s(n_elements(s)-2) ;get structure type of tag by=strmid(by,sp+1,strlen(by)) by=strtrim(by,2) ;rah 8/20/91 case ntype of 1: b=byte(by) ;byte 2: b=fix(by) ;integer 3: b=long(by) ;longword integer 4: b=float(by) ;floating 5: b=double(by) ;double precision 6: b=complex(by) ;complex 7: b=strtrim(by) ;string, no trailing blanks endcase if ((key eq 'COMMENT') or (key eq 'HISTORY')) then begin if (key eq 'COMMENT') then begin jcomment=jcomment+1 a.comment(jcomment) = b endif else begin jhistory = jhistory+1 jhistory=jhistory<9 a.history(jhistory) = b endelse endif else a.(i)=b if((key eq 'TEMP_FNG')) then begin ; put a.temp_fng in a.temp a.temp = b endif endif else begin ;3/15/91 if verbose eq 1 then begin ;6/20/93 print,'Unrecognized Header Keyword: ',Key ;3/15/91 print,'In file: ',f+'.hdr' ;3/15/91 endif else begin ;6/20/93 nun = nun+1 ;6/20/93 endelse ;6/20/93 endelse ;3/15/91 endif endrep until eof(lu) if ((nun gt 0) and (verbose ge 0)) then $ ;7/08/93 print, 'Total of unrecognized Keywords:', nun ;6/20/93 close,lu free_lun,lu ima_header = a return, nun ; eod: on_ioerror, null free_lun, lu message, !err_string, /NONAME, /IOERROR return,nun ; end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: READ_IMA_FRAME ; PURPOSE: reads a image frame from disk ; CATEGORY: BASIC_INTERFACE ; CALLING SEQUENCE: a = read_ima_frame(name,bitpix,nx,ny) ; INPUTS: name = string of the name of the file to read ; bitpix = nb of bits/pixel ; nx = nb de pixels en x ; ny = nb de pixels en y ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: a = array containing the image ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: RAH 7/2/90 ; rah 3/21/90 to account for non-integer input fil ; es ; rah 3/33/90 to check for datamax & datamin ; ALL 5/12/93 ; SCCS variables for IDL use ; ; @(#)read_ima_frame.pro 1.3 4/10/93 :NRL Solar Physics ;------------------------------------------------------------------------------ function read_ima_frame,name,bitpix,nx,ny ; filename = name check_imgdir check_filename,filename,path,extension if extension ne '' then filen = path+filename+'.'+extension $ else filen = path+filename ; get_lun,unit ok: IF !VERSION.OS eq 'vms' THEN openr,unit,filen,error=err,/block $ ELSE openr,unit,filen,error=err ; ; PRINT, 'err:',err ,'(-158 if file ist not found)' IF (err NE 0) and (extension eq '') THEN BEGIN ;A.LL. VMS version filen = filen+'.img' IF !VERSION.OS eq 'vms' THEN openr,unit,filen,error=err,/block $ ELSE openr,unit,filen,error=err ; ENDIF ; IF err EQ 0 THEN BEGIN PRINT, 'Readed image:',filen ENDIF ELSE BEGIN ;A.LL. VMS version ; IF !VERSION.OS NE 'vms' then BEGIN if (err EQ -150) or (err EQ -140) then begin openr,unit,!imgdir+filename+'.Z',error=errz if errz EQ 0 then begin close,unit print,format='($,a)','Please wait: uncompressing the image' filen = '/tmp/'+filename spawn,'cp '+!imgdir+filename+'.Z '+filen+'.Z' spawn,'uncompress '+filen print,'. Done.' temp = 1 goto,ok endif else begin print,err,!err_string return,errz endelse print,err,!err_string return,err endif ENDIF ELSE BEGIN ; VMS print, err,!err_string return,err ENDELSE ; ENDELSE ; ; case bitpix of 8: x=assoc(unit,bytarr(nx,ny)) 16: x=assoc(unit,intarr(nx,ny)) 32: x=assoc(unit,lonarr(nx,ny)) else: x=assoc(unit,fltarr(nx,ny)) endcase y=x(0) ; cas du 32 bits flotant a revoir! IF !VERSION.OS EQ 'vms' then BEGIN name = strupcase(filen) if ( strpos(name,'.IMG') ne -1 ) then BEGIN case bitpix of 16: byteorder,y 32: byteorder,y,/LSWAP endcase endif ENDIF free_lun,unit ; z = y(0:nx-1,0:ny-1) return,z end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: read_ima ; PURPOSE: reads a image and their header ; CATEGORY: BASIC_INTERFACES ; CALLING SEQUENCE: ima = read_ima(ima_name, hdrima, ichoice) ; INPUTS: ima_name Name of image ; hdrima Header structure ; ichoice Type of header ; 0 = IMA, 1 = BSC, 2=CAL, 3=C1 ; 4 = CCD. else external header ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: ima Image frame ; hdrima Filled header structure ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: RAH 10/1/89 ; RAH 8/20/91 Added AES BSBD camera keywords ; ALL 04/27/93 takes only standard KEYWORDS ; ; SCCS variables for IDL use ; ; @(#)read_ima.pro 1.1 7/6/92 :NRL Solar Physics ; ;----------------------------------------------------------------------------- Function read_ima, ima_name, hdrima, ichoice n = size(ichoice) ; if n(0) eq 0 and ( n(1) gt 0 and n(1) lt 5 ) then begin case ichoice of 0: hdrima = DEFINE_IMA_HDR(0) 1: hdrima = DEFINE_BSC_HDR(0) 2: hdrima = DEFINE_CAL_HDR(0) 3: hdrima = DEFINE_C1_HDR(0) 4: hdrima = DEFINE_CCD_HDR(0) endcase endif else begin n = size(hdrima) if ( n(0) ne 1 or n(2) ne 8 ) then begin err = -1 message, 'undefined header type' return, err endif endelse ; nima = ima_name check_filename,nima,path,extension nhdr = path+nima+'.hdr' num = READ_IMA_HDR( nhdr, hdrima, 0 ) ; nbit = hdrima.bitpix ; nx = hdrima.naxis1 ny = hdrima.naxis2 ; nima = path+nima if (extension ne '') then nima = nima+'.'+extension ima = READ_IMA_FRAME( nima, nbit, nx, ny) ; return,ima end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: WRITE_IMA ; PURPOSE: write image and header to disk file ; CATEGORY: BASIC_INTERFACE ; CALLING SEQUENCE: WRITE_IMAGE,ima_name,image,hdr ; INPUTS: ima_name = string of header filename ; image = array containing the image ; hdr = header to write to disk ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Writes to disk ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: Creates a new disk file ; RESTRICTIONS: Assumes file extensions of .img and .hdr ; PROCEDURE: ; MODIFICATION HISTORY: RAH 7/2/90 ; M.BOUT 93/11/16 runs for the new structures ; arrays and headers and saves them in two files ; ; NOTE: the procedure VISU_IMA is convenient for the displaying of the saved ; files. It's not the case of VISU_CAL. ; ; @(#)write_ima.pro 1.2 4/10/93 :NRL Solar Physics ; ;common ccd_header,header,nt,tags ; Modif. A.LL. 93/05/28 ;----------------------------------------------------------------------------- pro WRITE_IMA,ima_name,image,hdr hdr.filename=ima_name s=size(image) if s(0) ne 2 then begin print, s(0), ' dimensions image' if s(0) le 0 then return endif ; hdr.naxis1=s(1) if s(0) eq 1 then hdr.naxis2=1 else hdr.naxis2=s(2) get_lun,unit check_imgdir ; IF !VERSION.OS NE 'vms' THEN $ openw,unit,!imgdir+ima_name, ERROR=err ELSE $ openw,unit,!imgdir+ima_name, ERROR=err,/block ; IF err NE 0 THEN BEGIN err = 0 print,!imgdir,' not found, saved in local directory' spos = STRPOS(STRTRIM(ima_name),'c2c') ; c2 initial cal files IF spos EQ 0 THEN BEGIN print,'c2c... is a NON authorized name!' retall ENDIF spos = STRPOS(STRTRIM(ima_name),'c2n') ; c2 initial cal files IF spos EQ 0 THEN BEGIN print,'c2n... is a NON authorized name!' retall ENDIF ; IF !VERSION.OS NE 'vms' THEN $ ; openw,unit,ima_name, ERROR=err ELSE $ ; openw,unit,ima_name, ERROR=err/block ; ENDIF ; ;IF err NE 0 THEN BEGIN print, !err_string,' error n:',err ; retall ENDIF ; case s(3) of ; type of image 1: begin hdr.bitpix=8 x=assoc(unit,bytarr(hdr.naxis1,hdr.naxis2)) x(0)=image end 2: begin hdr.bitpix=16 x=assoc(unit,intarr(hdr.naxis1,hdr.naxis2)) x(0)=image end 3: begin hdr.bitpix=32 x=assoc(unit,lonarr(hdr.naxis1,hdr.naxis2)) x(0)=image end 4: begin hdr.bitpix=-32 x=assoc(unit,fltarr(hdr.naxis1,hdr.naxis2)) x(0)=image end else: begin hdr.bitpix=16 hdr.bzero=min(x,max=mx) hdr.bscale=(mx-mn)/65536L x=assoc(unit,intarr(hdr.naxis1,hdr.naxis2)) x(0)=fix((image-hdr.bzero)/hdr.bscale) end endcase ; cas du 32 bits flotant a revoir! IF !VERSION.OS EQ 'vms' then BEGIN name = strupcase(ima_name) if ( strpos(name,'.IMG') ne -1 ) then BEGIN case hdr.bitpix of 16: byteorder,x 32: byteorder,x,/LSWAP endcase endif ENDIF write_hdr,ima_name,hdr free_lun,unit return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: write_hdr.pro ; PURPOSE: write image header to disk file ; CATEGORY: General tools low level routine ; CALLING SEQUENCE: write_hdr,ima_name,hdr ; INPUTS: ima_name = string of header filename ; hdr = header to write to disk ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Writes to disk ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: Creates a new disk file ; RESTRICTIONS: Assumes a file extension of .hdr ; PROCEDURE: ; MODIFICATION HISTORY: RAH 10/1/89 ; RAH 8/20/91 to use = as keyword delimiter ; SCCS variables for IDL use ; ; @(#)write_header.pro 1.2 4/10/93 :NRL Solar Physics ; ;----------------------------------------------------------------------------- pro write_hdr,ima_name,hdr tags=tag_names(hdr) f=ima_name check_filename,f check_imgdir ; MODIF. A.LL 93/05/28 IF !VERSION.OS NE 'vms' THEN $ openw,lu,!imgdir+f+'.hdr',/get_lun ELSE $ openw,lu,!imgdir+f+'.hdr',/get_lun,/stream eqs='=' for i=0,n_tags(hdr)-1 do begin a=hdr.(i) s=size(a) ntype = s(n_elements(s)-2) ;get structure type of tag ntype = byte(ntype) case ntype of 1: if a ne 0b then $ ;byte printf,lu,format='(a,"=",i20)',tags(i),a 2: if a ne 0 then $ ;integer printf,lu,format='(a,"=",i20)',tags(i),a 3: if a ne 0l then $ ;longword printf,lu,format='(a,"=",i20)',tags(i),a 4: if a ne 0.0 then $ ;floating printf,lu,format='(a,"=",g20.8)',tags(i),a 5: if a ne 0.0 then $ ;double printf,lu,format='(a,"=",d20.13)',tags(i),a 6: if a ne 0.0 then $ ;complex printf,lu,format='(a,"=",2g20.8)',tags(i),a 7: if s(0) eq 0 then begin ; string if a ne '' then $ ;scalar string printf,lu,format='(a,"=",a)',tags(i),a endif else begin for j=0,s(1)-1 do if a(j) ne '' then $ printf,lu,format='(a,"=",a)',tags(i),a(j) endelse endcase endfor free_lun,lu return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: show_hdr.pro ; PURPOSE: visualize keywords in Calibration headers ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: show_hdr or show_hdr,/FULL ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: /FULL ; OUTPUTS: A list of ima_header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: ; All 4/25/93 for VMS files in general ; SCCS variables for IDL use ; ; @(#)show_hdr.pro 1.3 4/25/93 :LAS ; ;--------------------------------------------------------------------------- pro show_hdr,ima_hdr, FULL = I IF KEYWORD_SET(I) THEN BEGIN help, /STRUCTURE, ima_hdr ENDIF ELSE BEGIN print,' BITPIX:', ima_hdr.bitpix,' NAXIS :', ima_hdr.naxis print,' NAXIS1:', ima_hdr.naxis1,' NAXIS2:', ima_hdr.naxis2 ENDELSE return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: show_ima_hdr.pro ; PURPOSE: visualize keywords from file headers ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: show_ima_hdr, hdr_name ; show_ima_hdr, hdr_name,/FULL ; INPUTS: hdr_name Name of header file ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: /FULL ; OUTPUTS: A list of ima_header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: ; All 4/25/93 for VMS files in general ; ; corrected by M.B according to the new features of headers ; 11/03/93 ; SCCS variables for IDL use ; ; @(#)show_ima_hdr.pro 1.3 4/25/93 :LAS ; ;--------------------------------------------------------------------------- pro show_ima_hdr,ima_name, FULL = I ; hdrima = DEFINE_IMA_HDR(0) nima = ima_name check_filename,nima,path,extension nhdr = path+nima+'.hdr' num = READ_IMA_HDR( nhdr, hdrima, 0 ) IF KEYWORD_SET(I) THEN BEGIN show_hdr,hdrima,/full ENDIF ELSE BEGIN show_hdr,hdrima ENDELSE return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: set_cal_hdr.pro ; PURPOSE: set some keywords in Calibration headers ; CATEGORY: General tools low level routine ; CALLING SEQUENCE: set_ima_hdr,ima_header,refpix_x,refpix_y ; INPUTS: ima_header = structure ; refpix_x = float, (position of reference 0.,0.) ; refpix_y = float, (position of reference 0.,0.) ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: ima_header ; OPTIONAL OUTPUT PARAMETERS: ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: ; All 4/25/93 for VMS files in general ; SCCS variables for IDL use ; ; @(#)set_ima_header.pro 1.3 4/10/93 :NRL Solar Physics ; ;--------------------------------------------------------------------------- pro SET_CAL_HDR,ima_header a = ima_header a.CTYPE1 = 'MICRONS' a.CTYPE2 = 'MICRONS' a.CRVAL1 = 0. a.CRVAL2 = 0. a.CRPIX1 = (a.NAXIS1-1)*0.5 a.CRPIX2 = (a.NAXIS2-1)*0.5 REBINX = a.SUMCOL > 1 REBINY = a.SUMROW > 1 a.SUMROW = 1 a.SUMCOL = 1 a.CDELT1 = 21.*REBINX a.CDELT2 = 21.*REBINY ima_header = a ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: copy_ima_hdr.pro ; PURPOSE: procedure to copy a heder structure in other ; header structure ; CATEGORY: CCD ; CALLING SEQUENCE: copy_ima_hdr,header_in,header_out ; INPUTS: header_in = header input, ; header_out = new header structure ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: header_out = filled new header ; OPTIONAL OUTPUT PARAMETERS: ; SIDE EFFECTS: ; RESTRICTIONS: corresponding tags must be of same element type ; PROCEDURE: ; MODIFICATION HISTORY: All 4/25/93 for VMS files from Fusion ; SCCS variables for IDL use ; ; @(#)copy_ima_hdr.pro 1.3 4/10/93 :NRL Solar Physics ;-------------------------------------------------------------------------- pro copy_ima_hdr,header_in,header_out a_in = header_in a_out = header_out ; jcomment = -1 jhistory = -1 key='' tag_in = tag_names(header_in) tag_out = tag_names(header_out) nt_in = n_tags(header_in) nt_out = n_tags(header_out) ; PRINT,'Initial num of keys vs. final number:', nt_in,',', nt_out ; for i = 0,nt_in-1 do begin key = tag_in(i) key = strupcase(key) ; print, key j=where (key eq tag_out) ;find match of keyword with tagname if (n_elements(j) gt 0) then begin ;ignore unrecognized keywords 3/15/91 j = j(0) ;only take first occurence if (j ne -1) then begin if ((key eq 'COMMENT') or (key eq 'HISTORY')) then begin if (key eq 'COMMENT') then begin jcom = n_elements(a_in.comment) jout = n_elements(a_out.comment) jall = jcom < jout if (jall gt 0) then begin for jarr = jall,1,-1 do $ a_out.comment(jout-jarr) = a_in.comment(jcom-jarr) endif endif else begin jhis = n_elements(a_in.history) jout = n_elements(a_out.history) jall = jhis < jout if (jall gt 0) then begin for jarr = jall,1,-1 do $ a_out.history(jout-jarr) = a_in.history(jhis-jarr) endif endelse endif else a_out.(j) = a_in.(i) endif ; else begin ;3/15/91 ; print,'Unrecognized Header Keyword: ',Key ;3/15/91 ; endelse ;3/15/91 endif endfor header_out = a_out return ; end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: w512.pro ; PURPOSE: create a 512*512 window ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: extract_ima2, iin, hin, x1, x2, y1, y2, iout, hout ; INPUTS: n Window number ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: A image Window in the screen ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)extract_ima2.pro 1.0 25/6/93 :LAS ;--------------------------------------------------------------------------- pro w512, n WINDOW, n, TITLE='WINDOW'+STRING(n), XSIZE=512, RETAIN=2 return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: LOAD_IMA.PRO ; PURPOSE: Visualize a image array yet in memory ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: ima, lcut, hcut, kx, ky ; INPUTS: ima image array ; lcut,hcut low and hight cut ; kx, ky zoom parameters ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: image on screen ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)load_ima.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Function LOAD_IMA, ima, lcut, hcut, kx, ky imasize = size( ima ) if imasize(0) ne 2 then begin print, ' "ce n''est pas une image a 2 dimensions..." return, imasize endif ; nx = imasize(1) ny = imasize(2) nx1 = nx ny1 = ny ; if ( kx gt 1 or kx lt -1 ) then begin if ( kx lt 0 ) then begin nx1 = fix(nx/(-kx)) irest = nx-nx1*(-kx) istart = fix(irest/2) istop = nx-1+istart endif else begin nx1 = nx*kx istart = 0 istop = nx-1 endelse endif ; if ( kx gt 1 or kx lt -1 ) then begin if ( ky lt 0 ) then begin ny1 = fix(ny/(-ky)) jrest = ny-ny1*(-ky) jstart = fix(jrest/2) jstop = ny-1+jstart endif else begin ny1 = ny*ky jstart = 0 jstop = ny-1 endelse endif print,' Initial size:', nx, ny, ' Load size:', nx1, ny1 ; if ( nx ne nx1 ) or ( ny ne ny1 ) then $ ima_1 = rebin(ima(istart:istop,jstart:jstop),nx1,ny1) $ else ima_1 = ima tvscl,bytscl(ima_1, MIN=lcut, MAX=hcut) return, ima_1 end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: VISU_IMA.PRO ; PURPOSE: Put in virtual memory an image array & visualize it ; CATEGORY: Visualization high level routine ; CALLING SEQUENCE: VISU_IMA, ima_name, hima, ima, kx, ky, lcut, hcut ; INPUTS: ima_name image_name ; hima,ima IDL assoc names ; kx, ky zoom parameters ; lcut, hcut cuts values ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Image on screen ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: None ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; modified by M.B 11/04/93 ; SCCS variables for IDL use ; ; @(#)visu_ima.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro visu_ima, ima_name, hdr, ima, kx, ky, lcut, hcut ; ima1 = READ_IMA( ima_name, hdr, 0 ) imasize = size( ima1 ) if imasize(0) ne 2 then begin return endif ima = LOAD_IMA(ima1, lcut, hcut, kx, ky) return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: LOAD_CAL.PRO ; PURPOSE: Visualizes a array image of calibration ; (in memory yet) ; CATEGORY: Preprocessing high level routine ; CALLING SEQUENCE: iout = LOAD_CAL ( ima, lcut, hcut, itest, ; nx_out, ny_out ) ; INPUTS: ima image array ; lcut,hcut low an hight cuts ; itest operating mode for big images ; itest eq 1 not rebin ; itest ne 1 rebin by 2 if 1124 pix ; images ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Image on screen ; iout ; nx_out ; ny_out ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: None ; RESTRICTIONS: None ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)load_cal.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Function LOAD_CAL, ima, hima, lcut, hcut, itest, hout ; imasize = size( ima ) if imasize(0) ne 2 then begin print, ' "ce n''est pas une image a 2 dimensions..." return, imasize endif ; CLEAN_CAL, ima, hima, itest, iout, hout ; tvscl,bytscl(iout, MIN=lcut, MAX=hcut) ; return, iout end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: visu_cal_clean.pro ; PURPOSE: Gets a calib. image from disk, subtracts dark, and visualizes it ; CATEGORY: Calibration high level routine ; CALLING SEQUENCE: VISU_CAL_CLEAN, ima_name, backg, ima, hdr ; INPUTS: ima_name image name of calibration ; backg background image array ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Image on screen ; ima image array ; hdr header of image array ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: hdr array is defined as DEFINE_IMA_HDR ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)visu_cal_clean.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro visu_cal_clean, ima_name, backg, iout, hout ; ima = READ_IMA( ima_name, hima, 0 ) ; imasize = size( ima ) if imasize(0) ne 2 then begin return endif ; SET_CAL_HDR, hima ; itest = 0 ; CLEAN_CAL, ima, hima, itest, iout_0, hout ; iout = iout_0-backg hout.DATAMAX = MAX(iout) hout.DATAMIN = MIN(iout) ; lcut = -100. hcut = 8000. ; tvscl,bytscl(iout, MIN=lcut, MAX=hcut) ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: read_cal.pro ; PURPOSE: Gets a calibration image from disk and visualizes it ; CATEGORY: Calibrations high level routine ; CALLING SEQUENCE: READ_CAL, ima_name, itest, ima, hdr ; INPUTS: ima_name image name of calibration ; itest =0 rebin si nx = 1124 ; =1 no rebin pour nx = 1124 ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Image on screen ; ima image array ; hdr header of image array ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: hdr array is defined as DEFINE_IMA_HDR ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)read_cal.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro read_cal, ima_name, itest, iout, hout ; ima = READ_IMA(ima_name,hima,0) ; imasize = size( ima ) if imasize(0) ne 2 then begin print, ' "ce n''est pas une image a 2 dimensions..." return endif ; SET_CAL_HDR, hima ; CLEAN_CAL, ima, hima, itest, iout, hout ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: visu_cal.pro ; PURPOSE: Gets a calibration image from disk and visualizes it ; CATEGORY: Calibrations high level routine ; CALLING SEQUENCE: VISU_CAL, ima_name, ima, hdr ; INPUTS: ima_name image name of calibration ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: Image on screen ; ima image array ; hdr header of image array ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: hdr array is defined as DEFINE_IMA_HDR ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)visu_cal.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro visu_cal, ima_name, iout, hout ; ima = READ_IMA(ima_name,hima,0) ; imasize = size( ima ) if imasize(0) ne 2 then begin print, ' "ce n''est pas une image a 2 dimensions..." return endif ; SET_CAL_HDR, hima ; iout = LOAD_CAL (ima, hima, 0., 16000., 0, hout ) ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: CLEAN_CAL.PRO ; PURPOSE: Resizes and rotates a calibration image array ; CATEGORY: Calibrations high level routine ; CALLING SEQUENCE: CLEAN_CAL, ima, hima, itest, iout, hout ; INPUTS: ima image array of calibration ; hima header ; itest operating mode for big images ; itest eq 1 not rebin ; itest ne 1 rebin by 2 if 1124 pix ; images ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:iout image array ; hout header of image array ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: hdr array is defined as DEFINE_IMA_HDR ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)clean_cal.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro CLEAN_CAL, ima, hima, itest, iout, hout imasize = size( ima ) if imasize(0) ne 2 then begin print, ' "ce n''est pas une image a 2 dimensions..." return endif ; ; extraction de la zone utile er rotation ; nx = hima.NAXIS1 ny = hima.NAXIS2 nx_out = ny ny_out = nx case 1 of (nx eq 562): begin Xdec = 9 iout = ROTATE(ima(Xdec:Xdec+511,0:ny-1),3) i_rebin = 0 end (nx eq 1124): begin Xdec = 19 if itest eq 1 then begin iout = ROTATE(ima(Xdec:Xdec+1023,0:ny-1),3) nx_out = 1024 ny_out = nx endif else begin ima_2 = REBIN(ima(Xdec:Xdec+1023,0:ny-1),512,ny/2) iout = ROTATE(ima_2,3) nx_out = 512 ny_out = nx/2 endelse end else: begin Xdec = 0 iout = ROTATE(ima,1) nx_out = ny ny_out = nx end endcase ; ; preparation du header correspondant a "iout" ; hout = DEFINE_CAL_HDR(0) COPY_IMA_HDR, hima, hout year = hima.DATE DATE_NUM_TEXT, year, month, day, hour ; hout.JT = DATE_CAL( hima.DATE_OBS, hima.TIME_OBS ) hout.BSCALE = 1. hout.BZERO = 0. hout.BUNIT = 'ADU/SEC ' hout.DATE = day+'/'+month+'/'+year hout.TIME = hour hout.NAXIS1 = nx_out hout.NAXIS2 = ny_out hout.CTYPE1 = hima.CTYPE2 hout.CRVAL1 = hima.CRVAL2 hout.CTYPE2 = hima.CTYPE1 hout.CRVAL2 = hima.CRVAL1 if i_rebin eq 0 then begin hout.CRPIX1 = nx_out-1-hima.CRPIX2 hout.CDELT1 = -hima.CDELT2 hout.CRPIX2 = hima.CRPIX1-Xdec hout.CDELT2 = hima.CDELT1 hout.SUMCOL = hima.SUMROW hout.SUMROW = hima.SUMCOL endif else begin hout.CRPIX1 = nx_out-1-.5*hima.CRPIX2 hout.CDELT1 = -2.*hima.CDELT2 hout.CRPIX2 = .5*(hima.CRPIX1-Xdec) hout.CDELT2 = 2.*hima.CDELT1 hout.SUMCOL = 2*hima.SUMROW hout.SUMROW = 2*hima.SUMCOL endelse hout.DATAMAX = MAX(iout) hout.DATAMIN = MIN(iout) ; print, ' Initial Size:', nx, ny, ' Final Size:', nx_out, ny_out return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: stat_2d_frm.pro ; PURPOSE: Build a image of means and a image of sd (standard deviations) ; CATEGORY: General tools high level routines, Statistics. ; CALLING SEQUENCE: stat_2d_frm, ima,kx,ky,imb,imc ; INPUTS: ima image array ; kx step_size in x ; ky step_size in y ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:imb image array of means ; imc image array of sd. deviations ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)stat_2d_frm.pro 1.0 25/6/93 :LAS ;--------------------------------------------------------------------------- pro stat_2d_frm,ima,kx,ky,imb,imc toim = size(ima) ndim = toim(0) IF (ndim NE 2) THEN BEGIN z = 0. return ENDIF ; ; Define size for new image ; nxa = toim(1) nya = toim(2) mx = fix(nxa/kx) my = fix(nya/ky) x1 = fix( (nxa-kx*mx)/2 ) y1 = fix( (nya-ky*my)/2 ) x2 = x1+mx*kx-1 y2 = y1+my*ky-1 ; IF (toim(ndim-2) LT 4) THEN $ imt = FLOAT(ima(x1:x2,y1:y2)) ELSE $ imt = ima(x1:x2,y1:y2) ; imb = REBIN(imt,mx,my) imt = REBIN(imt*imt,mx,my) imc = imt-imb*imb ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: stat_ima.pro ; PURPOSE: local statistics in a image array (in memory) ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: stat_ima, ima, x1, x2, y1, y2, z ; INPUTS: ima image array ; x1,x2 x interval of rectangle ; y1,y2 y interval of rectangle ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:z array of values ; z(0) = ntot ; z(1) = sum ; z(2) = moy ; z(3) = std ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)stat_ima.pro 1.0 25/6/93 :LAS ;--------------------------------------------------------------------------- pro stat_ima,ima,x1,y1,x2,y2,z ; toim = size(ima) ndim = toim(0) IF (ndim NE 2) THEN BEGIN z = 0. return ENDIF nx = x2-x1+1 ny = y2-y1+1 IF (toim(ndim-2) LT 4) THEN $ imb = FLOAT(ima(x1:x2,y1:y2)) ELSE $ imb = ima(x1:x2,y1:y2) ; sum = total(imb) sum2 = total(imb*imb) ntot = n_elements(imb) moy = sum/ntot var = sum2/ntot-moy^2 std = 0. mnm = MIN(imb) mxm = MAX(imb) med = MEDIAN(imb) ; print,'nb of pixels:',ntot,', total flux :',sum ; IF (var GT 0.) THEN BEGIN std = SQRT(var) print,'mean: :',moy,', std :',std ENDIF ELSE BEGIN print,'mean: :',moy,', var :',var ENDELSE print,'min :',mnm ,', max :',mxm print,'median :',med ; z = FLTARR(7) z(0) = ntot z(1) = sum z(2) = moy z(3) = std z(4) = mnm z(5) = mxm z(6) = med ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: MIN_2D_FRM.PRO ; PURPOSE: make an image of local minima ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: ima_out = min_2d_frm( ima_in, kx, ky) ; INPUTS: ima_in image array ; kx step_size in x ; ky step_size in y ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:ima_out mapping of local minima ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: None ; RESTRICTIONS: None ; PROCEDURE: ; MODIFICATION HISTORY: defined by M.B and A.LL 26/10/93 ; ; SCCS variables for IDL use ; ; @(#)min_2d_frm.pro 1.0 26/10/93 :LAS ;------------------------------------------------------------------------- Function min_2d_frm,ima,kx,ky toim = size(ima) ndim = toim(0) IF (ndim NE 2) THEN BEGIN z = 0. return, z ENDIF ; ; Define size for new image ; nxa = toim(1) nya = toim(2) mx = fix(nxa/kx) my = fix(nya/ky) x1 = fix( (nxa-kx*mx)/2 ) y1 = fix( (nya-ky*my)/2 ) x2 = x1+mx*kx-1 y2 = y1+my*ky-1 ; imb = REPLICATE(ima(0,0),mx,my) FOR iy = 0,my-1 DO BEGIN ystart = y1+iy*ky yend = ystart+ky-1 imk = ima(x1:x2,ystart:yend) FOR ix = 0,mx-1 DO BEGIN xstart = x1+ix*kx xend = xstart+kx-1 imb(ix,iy) = MIN(imk(xstart:xend,1:ky-1)) ENDFOR ENDFOR ; return, imb end ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: statima.pro ; PURPOSE: extract a image from another ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: extract_ima2, iin, hin, x1, x2, y1, y2, iout, hout ; INPUTS: iin image array ; hin header of image array ; x1,x2 x interval of rectangle ; y1,y2 y interval of rectangle ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:iout extracted image array ; hout header for extracted image ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: opens a catalog of darks ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)extract_ima2.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Function statima,ima,x1,y1,x2,y2 toim = size(ima) ndim = toim(0) IF (ndim NE 2) THEN BEGIN z = FLTARR(4) return,z ENDIF nx = x2-x1+1 ny = y2-y1+1 IF (toim(ndim-2) LT 4) THEN $ imb = FLOAT(ima(x1:x2,y1:y2)) ELSE $ imb = ima(x1:x2,y1:y2) ; sum = total(imb) sum2 = total(imb*imb) ntot = n_elements(imb) moy = sum/ntot var = sum2/ntot-moy^2 std = 0. ; IF (var GT 0.) THEN std = SQRT(var) ; z = FLTARR(4) z(0) = ntot z(1) = sum z(2) = moy z(3) = std ; return,z end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: extract_ima2.pro ; PURPOSE: extract a image from another ; CATEGORY: General tools high level routine ; CALLING SEQUENCE: extract_ima2, iin, hin, x1, x2, y1, y2, iout, hout ; INPUTS: iin image array ; hin header of image array ; x1,x2 x interval of rectangle ; y1,y2 y interval of rectangle ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:iout extracted image array ; hout header for extracted image ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: opens a catalog of darks ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; corrected by M.B 11/03/93 for header's filling ; ; SCCS variables for IDL use ; ; @(#)extract_ima2.pro 1.0 25/6/93 :LAS ;------------------------------------------------------------------------- pro extract_ima2, iin, hin, x1, x2, y1, y2, iout, hout ; imasize = size( iin ) if imasize(0) ne 2 then begin text = "Image with "+string(imasize(0), FORMAT='(I2)')+" dimensions..." Message, text return endif ; nx = imasize(1) ny = imasize(2) nx_out = x2-x1+1 ny_out = y2-y1+1 if nx_out le 0 and ny_out le 0 then goto, error1 if x1 lt 0 or x2 gt ny then goto, error2 if y1 lt 0 or y2 gt ny then goto, error2 ; iout = iin(x1:x2,y1:y2) ; hout = DEFINE_CAL_HDR(0) ; hout.BITPIX = hin.BITPIX hout.NAXIS = 2 hout.NAXIS1 = nx_out hout.NAXIS2 = ny_out ; hout.CTYPE1 = hin.CTYPE1 hout.CRVAL1 = hin.CRVAL1 hout.CRPIX1 = hin.CRPIX1 hout.CDELT1 = hin.CDELT1 hout.CTYPE2 = hin.CTYPE2 hout.CRVAL2 = hin.CRVAL2 hout.CRPIX2 = hin.CRPIX2 hout.CDELT2 = hin.CDELT2 hout.SUMCOL = hin.SUMCOL hout.SUMROW = hin.SUMROW ; date_num_text, year, month, day, hour hout.DATE = day+'/'+month+'/'+year hout.TIME = hour date_out = day+' '+month+' '+year hout.JT = date_cal( date_out, hour ) ; jhis = n_elements(hin.HISTORY) for jin = 0,jhis-1 do $ if hin.HISTORY(jin) ne '' then goto, CT1 CT1: jtot = jin jout = n_elements(hout.HISTORY)-1 jall = jtot < jout ; if (jall gt 0) then begin j = jtot for jarr = jall,1,-1 do begin hout.HISTORY(jarr-1) = hin.HISTORY(j) j = j-1 endfor endif hout.HISTORY(jall) = 'extract_ima2,iin,hin,'+ $ STRING(x1)+','+STRING(x2)+','+ $ STRING(y1)+','+STRING(y2)+', iout, hout' return ; error1: message,'Dimensions for extracted image are inconsistent' return ; error2: message,'Limit values are out of image boundaries' return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME:DEFINE_CATALOG.pro ; PURPOSE Sets a array of structures for a image catalog ; CATEGORY: Preprocessing low level ; CALLING SEQUENCE: db = DEFINE_CATALOG(nfiles) ; INPUTS: nfiles Nombre max of files in catalog ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: a array structure for catalog ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: None ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)DEFINE_CATALOG.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Function DEFINE_CATALOG, nfiles ; int = 0 str = '' flt = 0.0 dbl = 0.d0 lon = 0L ; db = {DB_IMG, $ name :str, $ nx :int, $ ny :int, $ date :str, $ time :str, $ juldat :dbl, $ expo :flt, $ binx :int, $ biny :int, $ frst_col:int, $ frst_row:int} ; ima_db = REPLICATE( db, nfiles ) ; return,ima_db end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: IMA_LIST.pro ; PURPOSE: list the catalog of images (corresp to a template) ; CATEGORY: Preprocessing low level routine ; CALLING SEQUENCE: DARK_LIST, template, ima_db, nfiles ; INPUTS: template Template to define the list of images ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:ima_db image catalog ; nfiles Number of images in catalog ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: opens a catalog of darks ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)ima_list.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro IMA_LIST, template, ima_db, nfiles ; pos = strpos( strupcase(template),'.HDR') if pos lt 0 then begin print, ' FILE NAMES must got a .hdr extension!' retall endif ; hdr = DEFINE_IMA_HDR(0) ; list_files = FINDFILE( template ) nfiles = N_ELEMENTS(list_files) if nfiles le 0 then begin print, ' NOT FILES FOUND' retall endif ; ima_db = DEFINE_CATALOG( nfiles ) ; FOR n = 0,nfiles-1 DO BEGIN ierr = READ_IMA_HDR( list_files(n), hdr, -1 ) IMA_DB(n).name = list_files(n) IMA_DB(n).nx = hdr.NAXIS1 IMA_DB(n).ny = hdr.NAXIS2 IMA_DB(n).date = hdr.DATE_OBS IMA_DB(n).time = hdr.TIME_OBS IMA_DB(n).juldat = DATE_CAL( hdr.DATE_OBS, hdr.TIME_OBS ) IMA_DB(n).expo = hdr.EXPTIME IF hdr.SUMCOL LE 0 THEN IMA_DB(n).binx = 1 ELSE IMA_DB(n).binx = hdr.SUMCOL IF hdr.SUMROW LE 0 THEN IMA_DB(n).biny = 1 ELSE IMA_DB(n).biny = hdr.SUMROW IMA_DB(n).frst_col = hdr.PCOL IMA_DB(n).frst_row = hdr.PROW ENDFOR return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: find_ima.pro ; PURPOSE: From the image header finds the asociate dark in dark catalog ; CATEGORY: Preprocessing low level ; CALLING SEQUENCE: find_ima, hdr, ima_db, ima_name ; INPUTS: hdr image header ; ima_db image catalog ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS:ima_name name of associated image in catalog ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: None ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; corrected by M.B 11/03/93 for darks without shutter ; ; SCCS variables for IDL use ; ; @(#)find_ima.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro FIND_IMA, hdr, ima_db, ima_name ; nx = hdr.NAXIS1 ny = hdr.NAXIS2 binx = hdr.SUMCOL biny = hdr.SUMROW expo = hdr.EXPTIME jd_obs = DATE_CAL( hdr.DATE_OBS, hdr.TIME_OBS ) ; PRINT, 'JUL_DAY:',jd_obs ; db_vec = (nx eq ima_db.nx) and (ny eq ima_db.ny) $ and (binx eq ima_db.binx) and (biny eq ima_db.biny) $ and (ABS(expo) eq ABS(ima_db.expo)) ok_list = WHERE(db_vec,n) time_list = ima_db( ok_list ).juldat ;for j = 0,n-1 do print,ok_list(j),time_list(j) tim_min = MIN( ABS(time_list-jd_obs), n ) ; ima_name = ima_db(ok_list(n)).name ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: SET_CATALOG.PRO ; PURPOSE: Set a catalog of images in memory ; CATEGORY: Preprocessing high level routine ; CALLING SEQUENCE: SET_CATALOG ; INPUTS: template Template For image names ; db_dark Liste of images ; ndarks Number of images in catalog ; drk_name Associate dark name ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: catalog list in the screen ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: opens a catalog of darks if it don't exists ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)set_catalog.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro SET_CATALOG, template, db_dark, ndarks, drk_name ; if N_ELEMENTS(db_dark) lt 300 then begin db_dark = DEFINE_CATALOG( 300 ) ndarks = 0 drk_name = '' endif ; if (!version.os eq 'vms') then begin kpos = STRPOS( template,']' ) if kpos gt -1 then begin lens = STRLEN( template )-kpos stemp = STRMID( template, kpos+1, lens ) endif else begin stemp = template endelse ipos = STRPOS( stemp,'.' ) if ipos gt -1 then $ temp_b = STRMID( stemp, 0, ipos )+'.hdr' $ else temp_b = stemp+'.hdr' endif else begin ipos = STRPOS( template,'.' ) if ipos gt -1 then $ temp_b = STRMID( template, 0, ipos )+'.hdr' $ else temp_b = template+'.hdr' endelse IMA_LIST, temp_b, db_files, nfiles ; print,' Name Size x,y Date Time Jul.Date' $ ,' T.exp rebin starts' ; ndarks = nfiles if (!version.os eq 'vms') then begin line = '' FOR i = 0,ndarks-1 DO BEGIN db_dark(i) = db_files(i) fname = db_dark(i).name check_filename, fname, path, extension line = STRING( fname, FORMAT='(A15)') $ + STRING( db_dark(i).nx, FORMAT='(I5)') $ + STRING( db_dark(i).ny, FORMAT='(I5)') $ + STRING( db_dark(i).date, FORMAT='(A12)') $ + STRING( db_dark(i).time, FORMAT='(A10)') $ + '>' $ + STRING( db_dark(i).juldat, FORMAT='(F13.6)') $ + STRING( db_dark(i).expo, FORMAT='(F5.1)') $ + STRING( db_dark(i).binx, FORMAT='(I2)') $ + STRING( db_dark(i).biny, FORMAT='(I2)') $ + STRING( db_dark(i).frst_col, FORMAT='(I4)') $ + STRING( db_dark(i).frst_row, FORMAT='(I4)') print, line ENDFOR endif else begin FOR i = 0,ndarks-1 DO BEGIN db_dark(i) = db_files(i) print, db_dark(i), $ FORMAT='(A,I5,I5,1X,A,1X,A,1H=,F13.6,1X,F5.1,I3,I3,I4,I4)' ENDFOR endelse ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: show_catalog.pro ; PURPOSE: list the catalog in memory ; CATEGORY: Preprocessing ; CALLING SEQUENCE: SHOW_CATALOG ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: catalog list in the screen ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: CATA, db_dark, ndarks, drk_name ; SIDE EFFECTS: opens a catalog of darks if this dont exists ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)show_catalog.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro SHOW_CATALOG ; common CATA, db_dark, ndarks, drk_name ; if N_ELEMENTS(db_dark) lt 300 then begin db_dark = DEFINE_CATALOG( 300 ) ndarks = 0 drk_name ='' endif ; if ndarks le 0 then begin print, ' The DARK_FIELDS catalog is empty! ' return endif ; print,' Name Size x,y Date Time Jul.Date' $ ,' T.exp rebin starts' ; ;db = {DB_IMG, $ ; name :str, $ ; nx :int, $ ; ny :int, $ ; date :str, $ ; time :str, $ ; juldat :dbl, $ ; expo :flt, $ ; binx :int, $ ; biny :int, $ ; frst_col:int, $ ; frst_row:int} ; if (!version.os eq 'vms') then begin n_dark = -1 line = '' dname = drk_name check_filename, dname FOR i = 0,ndarks-1 DO BEGIN fname = db_dark(i).name check_filename, fname, path, extension line = STRING( fname, FORMAT='(A15)' ) $ + STRING( db_dark(i).nx, FORMAT='(I5)') $ + STRING( db_dark(i).ny, FORMAT='(I5)') $ + STRING( db_dark(i).date, FORMAT='(A12)')$ + STRING( db_dark(i).time, FORMAT='(A10)') $ + '>' $ + STRING( db_dark(i).juldat, FORMAT='(F13.6)') $ + STRING( db_dark(i).expo, FORMAT='(F5.1)') $ + STRING( db_dark(i).binx, FORMAT='(I2)') $ + STRING( db_dark(i).biny, FORMAT='(I2)') $ + STRING( db_dark(i).frst_col, FORMAT='(I4)') $ + STRING( db_dark(i).frst_row, FORMAT='(I4)') print, line if fname eq dname then n_dark = i ENDFOR endif else begin n_dark = -1 FOR i = 0,ndarks-1 DO BEGIN print, db_dark(i), $ FORMAT='(A,I5,I5,1X,A,1X,A,1H=,F13.6,1X,F5.1,I3,I3,I4,I4)' if db_dark(i).name eq drk_name then n_dark = i ENDFOR endelse ; if (n_dark ge 0 and n_dark lt ndarks) then $ print,' Actived dark_field:', drk_name $ else $ print,' Any Dark_field is actived' ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: list_ima_param.pro ; PURPOSE: list the catalog in memory ; CATEGORY: Preprocessing ; CALLING SEQUENCE: CHOOSE_DARK, drk_new_name, drk, hdrk ; INPUTS: template Template of files names to list ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: catalog lis in the screen ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: None ; SIDE EFFECTS: None ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)list_ima_param.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro list_ima_param, template ; SET_CATALOG, template, db_ima, nima, ima_name ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: choose_dark.pro ; PURPOSE: defines a dark frame as the active dark ; CATEGORY: Preprocessing ; CALLING SEQUENCE: CHOOSE_DARK, drk_new_name, drk, hdrk ; INPUTS drk_new_name Name of dark array ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: drk array of data ; hdrh header of data array ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: CATA, db_dark, ndarks, drk_name ; SIDE EFFECTS: fullfills the dark catalog common ; if it don't exists ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)choose_dark.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro CHOOSE_DARK, dark_new_name, drk, hdrk ; common CATA, db_dark, ndarks, drk_name ; if N_ELEMENTS(db_dark) lt 300 then begin db_dark = DEFINE_DB_IMA( 300 ) ndarks = 0 drk_name ='' endif ; if ndarks le 0 then begin print, ' The DARK_FIELDS catalog is empty! ' return endif ; template = dark_new_name list_files = FINDFILE( template ) nfiles = N_ELEMENTS(list_files) case nfiles of 0: begin print, 'File not found' return end 1: begin drk_full_name = list_files(0) end else: begin print, 'They are ',nfiles,' files for this choice, the 1srt is choosed' drk_full_name = list_files(0) end endcase ; name_list = STRUPCASE(db_dark(0:ndarks-1).name) check_filename, name_list name_dark = STRUPCASE(drk_full_name) check_filename, name_dark n_dark = WHERE( name_list eq name_dark ) if (n_dark(0) ge 0 and n_dark(0) lt ndarks) then begin READ_CAL, drk_full_name, 1, drk, hdrk drk_name = drk_full_name endif else begin print,' Not in the catalog. Please, reset the catalog of darks' endelse return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: get_drk_name.pro ; PURPOSE: founds de associate dark frame for ; a image and gets their name ; CATEGORY: Preprocessing high level ; CALLING SEQUENCE: get_drk_name, ima_name, drk_name ; INPUTS: ima_name Name of image ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: ass_name Name of associate dark frame ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: CATA, db_dark, ndarks, drk_name ; SIDE EFFECTS: 1) defines de found dark as the active dark ; 2) fullfills the dark catalog common if it ; don't exists ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)get_drk_name.pro 1.0 25/6/93 :LAS ; ;----------------------------------------------------------------------------- ; Pro get_drk_name, ima_name, ass_name ; common CATA, db_dark, ndarks, drk_name ; if N_ELEMENTS(db_dark) lt 300 then begin db_dark = DEFINE_DB_IMA( 300 ) ndarks = 0 drk_name ='' endif ; ima_hdr = DEFINE_IMA_HDR(0) ierr = READ_IMA_HDR( ima_name, ima_hdr, 0 ) FIND_IMA, ima_hdr, db_dark , ass_name ; return end ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: DARK_CATA.pro ; PURPOSE: Set a catalog of darks in memory ; CATEGORY: Preprocessing high level routine ; CALLING SEQUENCE: SET_CATALOG ; INPUTS: None ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: catalog list in the screen ; Modifies CATA common ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: CATA, db_dark, ndarks, drk_name ; SIDE EFFECTS: ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; ; SCCS variables for IDL use ; ; @(#)set_catalog.pro 1.0 25/6/93 :LAS ; ;---------------------------------------------------------------------------- ; pro DARK_CATA ; common CATA, db_dark, ndarks, drk_name ; SET_CATALOG, 'c2n*.hdr',db_dark, ndarks, drk_name return end ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; NAME: pro_cal.pro ; PURPOSE: get in memory an image and ; substracts the right dark ; CATEGORY: Preprocessing high level routine ; CALLING SEQUENCE: PRO_CAL, ima_name, drk, hdrk, iout, hout ; INPUTS: ima_name Name of image to process ; OPTIONAL INPUT PARAMETERS: None ; KEYWORD PARAMETERS: None ; OUTPUTS: drk Associate dark array ; hdrk Associate header of dark ; iout Corrected image array ; hout Header for corrected image array ; OPTIONAL OUTPUT PARAMETERS: None ; COMMON BLOCKS: CATA, db_dark, ndarks, drk_name ; SIDE EFFECTS: opens a catalog of darks if this doesn't exist ; and associates a dark to frame ; RESTRICTIONS: ; PROCEDURE: ; MODIFICATION HISTORY: defined by ALL 6/24/93 ; rewritted and corrected by M.B 11/04/93 ; ; SCCS variables for IDL use ; ; @(#)pro_cal.pro 1.0 25/6/93 :LAS ;----------------------------------------------------------------------------- Pro pro_cal, ima_name, drk, hdrk, iout, hout ; ; reading image file ; ima = READ_IMA( ima_name, hima, 0 ) imasize = size( ima ) if imasize(0) ne 2 then begin ;pas d'image print,'PRO_CAL error ',ima_name,' is not a 2 dim image !?' return endif SET_CAL_HDR, hima itest = 0 CLEAN_CAL, ima, hima, itest, iout_0, hout_0 ; ; looking for the nearest dark frame ; common CATA, db_dark, ndarks, drk_name ; if N_ELEMENTS(db_dark) lt 300 then begin db_dark = DEFINE_DB_IMA( 300 ) ndarks = 0 drk_name ='' endif ; ima_hdr = DEFINE_IMA_HDR(0) ierr = READ_IMA_HDR( ima_name, ima_hdr, 0 ) FIND_IMA, ima_hdr, db_dark , new_drk_name new_name = new_drk_name check_filename, new_name, path, extension new_name = new_name+'.img' ; ; reading dark frame if necessary ; old_name = drk_name check_filename, old_name, path, extension old_name = old_name+'.img' print, 'old dark:',old_name ; if ( new_name ne old_name ) then begin print,' new_dark:',new_name nwdark = READ_IMA( new_name, hdark, 0 ) nwdarksize = size( nwdark ) if nwdarksize(0) ne 2 then begin ;pas d'image print,'PRO_CAL error ',new_name,' is not a 2 dim image !?' return endif SET_CAL_HDR, hdark itest = 0 CLEAN_CAL, nwdark, hdark, itest, nwdark_0, hdark_0 drk = nwdark_0 hdrk = hdark_0 drk_name = new_drk_name endif else begin if ( keyword_set(drk) eq 0 ) then begin print,' dark:',new_drk_name nwdark = READ_IMA( new_drk_name, hdark, 0 ) nwdarksize = size( nwdark ) if nwdarksize(0) ne 2 then begin ;pas d'image print,'PRO_CAL error ',new_name,' is not a 2 dim image !?' return endif SET_CAL_HDR, hdark itest = 0 CLEAN_CAL, nwdark, hdark, itest, nwdark_0, hdark_0 drk = nwdark_0 hdrk = hdark_0 endif endelse print, ' Subtracing the dark field:',drk_name,' of the image' ; ; subtracting the dark frame ; iout = iout_0-drk hout = hout_0 ; ; ; hout.DATAMAX = MAX(iout) hout.DATAMIN = MIN(iout) ; jhis = n_elements(hima.HISTORY) for jin = 0,jhis-1 do $ if hima.HISTORY(jin) ne '' then goto, CT1 CT1: jtot = jin jout = n_elements(hout.HISTORY)-1 jall = jtot < jout ; if (jall gt 0) then begin j = jtot for jarr = jall,1,-1 do begin hout.HISTORY(jarr-1) = hima.HISTORY(j) j = j-1 endfor endif hout.HISTORY(jall) = 'PRO_CAL, '+ima_name+', '+drk_name ; ;help, iout ;help, /structures, hout ; ; viewing of the resulting frame ; toim = size(iout) ndim = toim(0) IF (toim(ndim-2) LT 4) THEN $ iout = FLOAT(iout(0:511,0:511)) ELSE $ iout = iout(0:511,0:511) ; sum = total(iout) sum2 = total(iout*iout) ntot = n_elements(iout) mean = sum/ntot var = sum2/ntot-mean^2 sigma = 0. mnm = MIN(iout) mxm = MAX(iout) ; IF (var GT 0.) THEN BEGIN $ sigma = SQRT(var) low = mean-3.*sigma high = mean+3.*sigma tvscl,bytscl(iout,min=low,max=high) ENDIF ELSE BEGIN $ tvscl,bytscl(iout,min=mnm,max=mxm) ENDELSE ; return end