;****************************************************************************** ;* File name: ql_sffi_trt.pro * ;* * ;* Content : ql_write_fits_i * ;* : ql_sffi_event * ;* : ql_sffi_trt * ;* * ;* Date Author Comment * ;* -------------------------------------------------------------------------- * ;* 28-04-1994 E.PETIT Creation * ;* 10-01-1995 E.PETIT New header, update * ;* 19-06-1996 N.Morisset Patch, replace SSLOC by SSPGTYPE * ;****************************************************************************** ;*** ;*** ;############################################################################## ;#Procedure name : QL_WRITE_NEW_FITS_I # ;#Author : E.PETIT # ;#Purpose : Save currrent data in FITS format # ;#Creation date : 24-08-1995 # ;############################################################################## ;*** PRO QL_WRITE_FITS_I ;============================================================================ ; Common Block in use ;============================================================================ COMMON curr_data_i_com COMMON rrd_com COMMON target_com COMMON scient_com COMMON meth_com COMMON instr_id_com COMMON instr_evt_com COMMON const_com COMMON const2_com COMMON sff_com ;============================================================================ ; Initialization ;============================================================================ header = curr_header_i banner = curr_banner_i dctrl = curr_dctrl_i sumqlflg = 'T' origin = 'AXP/OPENVMS' telescop = 'SOHO' instrume = 'SUMER' exptime = header.SSEXPTIM refpix = header.SSREFPIX+1 refwln = header.SSWAVEL binx = header.SSBINNY biny = header.SSBINNZ rotcmp = header.SSROTCMP popudp = header.SSPOPUDP prog_id = header.SSADMCNT opcnt = header.SSOPCNT imgcnt = header.SSIMGCNT rasstp = header.SSRASSTP rassiz = FIX(header.SSRASSIZ) detbpx = header.SSBPADDY+1 detbpy = header.SSBPADDZ detbpval = header.SSBPCNTS detcnts = header.SSIMGTOT pgtype = header.SSPGTYPE compar1 = header.SSCOMPP1 compar2 = header.SSCOMPP2 compar3 = header.SSCOMPP3 cmpstat = FIX(header.CMPSTAT) stat = FIX(header.SSSTAT) detsta = header.SSDETSTA ininval = header.SSIIVALY ininvalx = FLOAT(header.SSIIDY) ininvaly = -FLOAT(header.SSIIDZ) ins_x = FLOAT(header.SSSUNY)/16. ins_y = -FLOAT(header.SSSUNZ)/16. cororb = 'F' ; Compute Cxxxx keywords ; ---------------------- tmp = image_type_lbl(header.DATATYPE) ctype1 = STRTRIM(STRMID (tmp, 0, STRPOS (tmp, '/')),2) ctype2 = STRTRIM(STRMID (tmp, STRPOS (tmp, '/')+1, STRLEN(tmp)-1),2) CASE ctype1 OF 'WAVELNTH': cunit1 = 'ANGSTROM' 'SOLAR_X' : cunit1 = 'ARCSEC' 'SOLAR_Y' : cunit1 = 'ARCSEC' 'TEMPORAL': cunit1 = 'S' ELSE : cunit1 = '?' ENDCASE CASE ctype2 OF 'WAVELNTH': cunit2 = 'ANGSTROM' 'SOLAR_X' : cunit2 = 'ARCSEC' 'SOLAR_Y' : cunit2 = 'ARCSEC' 'TEMPORAL': cunit2 = 'S' ELSE : cunit2 = '?' ENDCASE CASE ctype1 OF 'WAVELNTH': BEGIN crpix1 = refpix cval1 = refwln cdelt1 = (curr_dctrl_i.x.max-curr_dctrl_i.x.min)/(curr_dctrl_i.x.nb_dot-1) END ELSE : BEGIN crpix1 = 1 cval1 = curr_dctrl_i.x.min cdelt1 = (curr_dctrl_i.x.max-curr_dctrl_i.x.min)/(curr_dctrl_i.x.nb_dot-1) END ENDCASE CASE ctype2 OF 'WAVELNTH': BEGIN crpix2 = refpix cval2 = refwln cdelt2 = (curr_dctrl_i.y.max-curr_dctrl_i.y.min)/(curr_dctrl_i.y.nb_dot-1) END ELSE : BEGIN crpix2 = 1 cval2 = curr_dctrl_i.y.min cdelt2 = (curr_dctrl_i.y.max-curr_dctrl_i.y.min)/(curr_dctrl_i.y.nb_dot-1) END ENDCASE date_obs ='19' + STRING(header.SSEXPTYR,FORMAT='(I2.2)') + "-" + $ STRING(header.SSEXPTMO,FORMAT='(I2.2)') + "-" + $ STRING(header.SSEXPTDY,FORMAT='(I2.2)') + "T" + $ STRING(header.SSEXPTHR,FORMAT='(I2.2)') + ":" + $ STRING(header.SSEXPTMN,FORMAT='(I2.2)') + ":" + $ STRING(header.SSEXPTSC,FORMAT='(I2.2)') + "." + $ STRING(header.SSEXPTCS,FORMAT='(I3.3)') obt_time = UTC2TAI (date_obs) obt_end = UTC2TAI (date_obs) + DOUBLE (header.SSEXPTIM) ff = ((header.SSSTAT) AND '40'X) IF (ff EQ '40'X) THEN ffonoff = 'T' IF (ff EQ '00'X) THEN ffonoff = 'F' CASE (header.SSSTAT AND '30'X) OF '20'X : detector = '<1> A' '10'X : detector = '<2> B' '30'X : detector = '<3> RSC' ELSE : detector = '?' ENDCASE ininsmod = '???' CASE (header.SSSTAT AND '0C'X) OF '00'X : ininsmod = '<0> none' '04'X : ininsmod = '<1> IIF' '08'X : ininsmod = '<2> TC' '0C'X : ininsmod = '<3> TC and/or IIF' ELSE : ENDCASE slit = '???' CASE (header.SSSLITNB ) OF 1 : slit = '4*300 center' 2 : slit = '1*300 center' 3 : slit = '1*120 top' 4 : slit = '1*120 center' 5 : slit = '1*120 bottom' 6 : slit = '0.3*120 top' 7 : slit = '0.3*120 center' 8 : slit = '0.3*120 bottom' 9 : slit = '1 arcs hole' ELSE : ENDCASE slit = '<' + STRTRIM(STRING(header.SSSLITNB),2) + '> ' + slit object = '???' FOR i=0,nb_target-1 DO $ IF (target_lst(i).target_id EQ header.SSTARGET) THEN object=STRTRIM(target_lst(i).target_name,2) object = '<' + STRTRIM(STRING(header.SSTARGET),2) + '> ' + object scientis= '???' FOR i=0,nb_scient-1 DO $ IF (scient_lst(i).scient_id EQ header.SSSCIENT) THEN scientis = STRTRIM(scient_lst(i).scient_name,2) scientis = '<' + STRTRIM(STRING(header.SSSCIENT),2) + '> ' + scientis compress = '???' FOR i=0,nb_meth-1 DO $ IF (meth_lst(i).meth_id EQ FIX(header.SSCOMPRM)) THEN compress = STRTRIM(meth_lst(i).meth_name,2) compress = '<' + STRTRIM(STRING(FIX(header.SSCOMPRM)),2) + '> ' + compress ininm_id = '???' FOR i=0,nb_instr_id-1 DO $ IF (instr_id_lst(i).instr_id_id EQ header.SSIIMIDY) THEN ininm_id = STRTRIM(instr_id_lst(i).instr_id_name,2) ininm_id = '<' + STRTRIM(STRING(header.SSIIMIDY),2) + '> ' + ininm_id ininse = '???' FOR i=0,nb_instr_evt-1 DO $ IF (instr_evt_lst(i).instr_evt_id EQ header.SSIISEZ) THEN ininse = STRTRIM(instr_evt_lst(i).instr_evt_name,2) ininse = '<' + STRTRIM(STRING(header.SSIISEZ),2) + '> ' + ininse data_typ = '<' + STRTRIM(STRING(FIX(header.DATATYPE)),2) + '> ' +image_type_lbl(header.DATATYPE) ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; --------------------------------------------------------------------------- ; HEADER ; --------------------------------------------------------------------------- ; MANDATORY KEYWORDS ; ------------------ MKHDR, fits_hd, curr_data_i ; STANDARD FITS KEYWORDS AS USED BY SOHO ; -------------------------------------- FXADDPAR, fits_hd, 'SUMQLFLG', sumqlflg , 'QUICK LOOK FLAG' FXADDPAR, fits_hd, 'SORIG' , origin , 'ORIGINE' FXADDPAR, fits_hd, 'FILENAME', STRUPCASE(file_name) , 'FILENAME' FXADDPAR, fits_hd, 'TELESCOP', telescop , 'TELESCOP' FXADDPAR, fits_hd, 'INSTRUME', instrume , 'INSTRUMENT' FXADDPAR, fits_hd, 'SLIT' , slit , 'SLIT' FXADDPAR, fits_hd, 'OBJECT' , object , 'TARGET' ; ADDITIONAL SOHO KEYWORDS ; ------------------------ FXADDPAR, fits_hd, 'DATE_OBS', date_obs , 'OBSERVATION DATE' FXADDPAR, fits_hd, 'OBT_TIME', obt_time , 'OBSERVATION DATE (TAI)' FXADDPAR, fits_hd, 'OBT_END' , obt_end , 'OBSERVATION END DATE (TAI)' FXADDPAR, fits_hd, 'DETECTOR', detector , 'DETECTOR' FXADDPAR, fits_hd, 'EXPTIME' , exptime , 'EXPOSURE TIME' FXADDPAR, fits_hd, 'DATA_TYP', data_typ , 'DATA TYPE' FXADDPAR, fits_hd, 'DET_X' , refpix , 'REFERENCE PIXEL 1-1024' FXADDPAR, fits_hd, 'DET_Y' , vert_ref_pix+1 , 'REFERENCE PIXEL 1-360' FXADDPAR, fits_hd, 'WAVELNTH', refwln , 'REFERENCE WAVELENGTH' ; DATA MANAGEMENT KEYWORDS ; ------------------------ FXADDPAR, fits_hd, 'BINX' , binx , 'X BINNING FACTOR' FXADDPAR, fits_hd, 'BINY' , biny , 'Y BINNING FACTOR' FXADDPAR, fits_hd, 'ROTCMP' , rotcmp , 'SOLAR ROTATION COMPENSATION' FXADDPAR, fits_hd, 'POPUDP' , popudp , 'POP/UDP NUMBER' FXADDPAR, fits_hd, 'PROG_ID' , prog_id , 'INSTANCE OF POP/UDP' FXADDPAR, fits_hd, 'OPCNT' , opcnt , 'OPERATION COUNTER' FXADDPAR, fits_hd, 'IMGCNT' , imgcnt , 'IMAGE COUNTER COUNTER' FXADDPAR, fits_hd, 'RASSTP' , rasstp , 'RASTER STEP' FXADDPAR, fits_hd, 'RASSIZ' , rassiz , 'RASTER SIZE' FXADDPAR, fits_hd, 'DETBPX' , detbpx , 'DETECTOR BRIGHTEST PIX /X' FXADDPAR, fits_hd, 'DETBPY' , detbpy , 'DETECTOR BRIGHTEST PIX /Y' FXADDPAR, fits_hd, 'DETBPVAL', detbpval , 'DETECTOR BRIGHTEST PIX VALUE' FXADDPAR, fits_hd, 'DETCNTS' , detcnts , 'TOTAL COUNTS ON DETECTOR' FXADDPAR, fits_hd, 'PGTYPE' , pgtype , 'PROGRAM TYPE (0: POP or SCL Function/ 1: UDP)' FXADDPAR, fits_hd, 'SCIENTIS', scientis , 'SCIENTIST' FXADDPAR, fits_hd, 'FFONOFF' , ffonoff , 'FLAT FIELD CORRECTION' FXADDPAR, fits_hd, 'COMPRESS', compress , 'DATA COMPRESSION METHOD' FXADDPAR, fits_hd, 'COMPAR1' , compar1 , 'COMPRESSION PARAMETER 1' FXADDPAR, fits_hd, 'COMPAR2' , compar2 , 'COMPRESSION PARAMETER 2' FXADDPAR, fits_hd, 'COMPAR3' , compar3 , 'COMPRESSION PARAMETER 3' FXADDPAR, fits_hd, 'CMPSTAT' , cmpstat , 'DE-COMPRESSION STATUS' FXADDPAR, fits_hd, 'STAT' , stat , 'STATUS' FXADDPAR, fits_hd, 'DETSTA' , detsta , 'DETECTOR STATUS' FXADDPAR, fits_hd, 'CTYPE1' , ctype1 , 'AXIS 1 type' FXADDPAR, fits_hd, 'CTYPE2' , ctype2 , 'AXIS 2 type' FXADDPAR, fits_hd, 'CUNIT1' , cunit1 , 'AXIS 1 unit' FXADDPAR, fits_hd, 'CUNIT2' , cunit2 , 'AXIS 2 unit' FXADDPAR, fits_hd, 'CRPIX1' , crpix1 , 'AXIS 1 REF PIXEL' FXADDPAR, fits_hd, 'CRPIX2' , crpix2 , 'AXIS 2 REF PIXEL' FXADDPAR, fits_hd, 'CVAL1' , cval1 , 'AXIS 1 REF VALUE' FXADDPAR, fits_hd, 'CVAL2' , cval2 , 'AXIS 2 REF VALUE' FXADDPAR, fits_hd, 'CDELT1' , cdelt1 , 'AXIS 1 INCREMENT' FXADDPAR, fits_hd, 'CDELT2' , cdelt2 , 'AXIS 2 INCREMENT' FXADDPAR, fits_hd, 'ININSMOD', ininsmod , 'SPHEL INTER INSTRUMENT MODE' FXADDPAR, fits_hd, 'ININM_ID', ininm_id , 'INTER INSTRUMENT MASTER ID' FXADDPAR, fits_hd, 'ININSE' , ininse , 'INTER INSTRUMENT EVENT' FXADDPAR, fits_hd, 'ININVALX', ininvalx , 'INTER INSTRUMENT EVENT/X' FXADDPAR, fits_hd, 'ININVALY', ininvaly , 'INTER INSTRUMENT EVENT/Y' ; POINTING KEYWORDS ; ----------------- FXADDPAR, fits_hd, 'INS_X' , ins_x , 'SUN X COORDINATE' FXADDPAR, fits_hd, 'INS_Y' , ins_y , 'SUN Y COORDINATE' ; ORBITAL PARAMETERS KEYWORDS ; --------------------------- FXADDPAR, fits_hd, 'CORORB' , cororb , 'ORBITOLOGY UPDATE' ; FILE PROCESSING KEYWORDS ; ------------------------ tagstr = TAG_NAMES(dctrl) FOR i=0,N_TAGS(dctrl)-4 DO BEGIN tmp = SUMER_ID_STR + ' ' + STRING(tagstr(i), FORMAT='(A13)') + ' = ' IF (STRING(tagstr(i)) EQ 'TITLE') THEN tmp=tmp+"'"+STRTRIM(dctrl.(i),2)+"'" $ ELSE tmp = tmp + STRTRIM(STRING(dctrl.(i)), 2) FXADDPAR, fits_hd, 'COMMENT' , tmp ENDFOR i = 0 N = N_ELEMENTS(dctrl.process_id) WHILE (i LT N-1) AND (dctrl.process_id(i) NE 0) DO BEGIN tmp = SUMER_ID_STR + ' ' + $ STRING('PROCESS_ID('+STRTRIM(STRING(i),2)+')',FORMAT='(A13)') + ' = ' + $ STRING(dctrl.process_id(i), FORMAT='(I2.2)') FXADDPAR, fits_hd, 'COMMENT' , tmp i = i+1 ENDWHILE tagstr = TAG_NAMES(dctrl.x) FOR i=0,N_TAGS(dctrl.x)-1 DO BEGIN tmp = SUMER_ID_STR + ' ' + $ STRING('X.'+tagstr(i), FORMAT='(A13)') + ' = ' IF (STRING(tagstr(i)) EQ 'COMMENT') THEN tmp=tmp+"'"+STRTRIM(dctrl.x.(i),2)+"'" $ ELSE tmp = tmp + STRTRIM(STRING(dctrl.x.(i)), 2) FXADDPAR, fits_hd, 'COMMENT' , tmp ENDFOR tagstr = TAG_NAMES(dctrl.y) FOR i=0,N_TAGS(dctrl.y)-1 DO BEGIN tmp = SUMER_ID_STR + ' ' + STRING('Y.'+tagstr(i), FORMAT='(A13)') + ' = ' IF (STRING(tagstr(i)) EQ 'COMMENT') THEN tmp=tmp+"'"+STRTRIM(dctrl.y.(i),2)+"'" $ ELSE tmp = tmp + STRTRIM(STRING(dctrl.y.(i)), 2) FXADDPAR, fits_hd, 'COMMENT' , tmp ENDFOR WRITEFITS, file_name, curr_data_i, fits_hd END ;*** ;############################################################################## ;#Procedure name : QL_SFFI_EVENT # ;#LEVEL : 1 # ;# # ;#Author : E.PETIT # ;#Language : IDL # ;#Purpose : Manage Image save in FITS format # ;#Creation date : 28-04-1994 # ;#External modules : # ;# # ;#Call sequence : Called by Event Handler # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## ;*** PRO QL_SFFI_EVENT, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON sff_com ;============================================================================ ; Initialization ;============================================================================ ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, ev.id, GET_UVALUE=value CASE value OF 'VALID': BEGIN WIDGET_CONTROL,file_txt, GET_VALUE=tmp file_name = STRCOMPRESS (tmp(0),/REMOVE_ALL) + '.FITS' ql_write_fits_i WIDGET_CONTROL, sff_base, /DESTROY END 'CANCEL': BEGIN WIDGET_CONTROL, sff_base, /DESTROY END ELSE: ENDCASE END ;*** ;############################################################################## ;#Procedure name : QL_SFFI_TRT # ;#LEVEL : 1 # ;# # ;#Author : E.PETIT # ;#Language : IDL # ;#Purpose : Manage Image save in FITS format # ;#Creation date : 28-04-1994 # ;#External modules : # ;# # ;#Call sequence : Called by Event Handler # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## ;*** PRO QL_SFFI_TRT, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON sff_com COMMON const_com ;============================================================================ ; Initialization ;============================================================================ Title = 'Image Save' file_name = 'IMAGE_QL' ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS sff_base = WIDGET_BASE (TITLE = title, XOFFSET=300, YOFFSET=190,/COLUMN,/MODAL) sff_ctrl = WIDGET_BASE (sff_base, /ROW) sff_cmd = WIDGET_BASE (sff_base, /ROW) dummy = WIDGET_LABEL (sff_ctrl , $ VALUE = 'File (Without extension): ', $ FONT = Hd_Font_Bold) file_txt= WIDGET_TEXT (sff_ctrl , $ VALUE = file_name , $ UVALUE = 'TEXT' , $ XSIZE = 20 , $ YSIZE = 1 , $ FONT = Hd_Font , $ /EDITABLE) file_ok = WIDGET_BUTTON(sff_cmd , $ VALUE = 'VALID' , $ UVALUE = 'VALID' , $ FONT = Hd_Font_Bold) file_ko = WIDGET_BUTTON(sff_cmd , $ VALUE = 'CANCEL' , $ UVALUE = 'CANCEL' , $ FONT = Hd_Font_Bold) WIDGET_CONTROL, sff_base, /REALIZE ; ------------- ; Event Manager ; ------------- XMANAGER, "ql_sffi", sff_base END