;------------------------------------------------------------------------ ; ; UVCS "Basic" Data Analysis and processing Software (DAS) ; ; File: das40.pro ("Basic code") Mar 05 ; ; Version: 40 ; ; Update to IDL version 5.0 on Aug. 13, 1997 (Carlo Benna) ; ; ; Carlo Benna, Aad van Ballegooijen - 1993, 1994 ; Aad van Ballegooijen, John Raymond - 1995 ; Silvio Giordano, Carlo Benna - 1995, 1997 ; Save FITS on "compress" format, Dec 25 1997 ; Read and display "extended header" fields - 2000 Dan Phillips ; Merge modifications, incl. pointing display - 2000 DP ; Added /sh to all 'spawn' calls; this calls the shell commmands ; through sh, avoiding the overhead of other shells and preventing a ; nasty conflict with SSW - 2000 DP ; Modified radiometric calibration routines - 2000 DP ; Added free_lun to FITS_READ to close opened file - DP 01 ; Added CMDMIR variable and display - DP 01 ; Two-file time-dependent calibration scheme - 2005 DP ;------------------------------------------------------------------------ ;------------------------------------------------------------------------- ; Return to XMANAGER: ;------------------------------------------------------------------------- pro X print, '%Return under XMANAGER' xmanager end ; Function DIR_EXIST ; ; NAME: DIR_EXIST ; ; PURPOSE: This function tests for the presence of a directory. ; ; CALLING SEQUENCE: Result = DIR_EXIST( Dir ) ; ; INPUTS: Dir String holding the name of the directory you want to ; test the existence of. ; ; OUTPUTS: This function returns ; 1 if the specified directory exists or ; 0 if the specified directory does NOT exist. ; ; Silvio Giordano ;%% function DIR_EXIST, dir ; ; Save the current directory: CD, CUR=cur ; ; An error will occur if we try to CD to a directory ; that doesn't exist: CATCH, error_status if (error_status NE 0) then begin ; Directory does NOT exist so: return, 0 endif ; ; Try to go to the directory. If it doesn't exist, ; the error handler code above gets executed: CD, dir ; ; If the directory does exist, we need to change back ; to the original directory and return true: CD, cur return, 1 ; end ; pro STP & st='' & read,'%Press Return to continue ',st & return & end ; ;-----------------------------------------------------------------------------; ; Function APPROX ; ; ; ; ex.: ; ; IDL> res=approx(2.345,2,STR='NO') ; ; IDL> help, res ; ; RES FLOAT = 2.35000 ; ; IDL> res=approx(2.345,2,STR='YES') ; ; IDL> help, res ; ; RES STRING = '2.35' ; ; IDL> res=approx(2345,-2,STR='NO') ; ; IDL> help, res ; ; RES INT = 2300 ; ; ; ; Revision : May 12 1997 ; ; Revision : Apr 27 1998 ; ; Revision : Dec 14 1998 Carlo Tronca Exponential values ; ; attenzione restituisce stringa ottimizzata ; ; per plot, cioe' del tipo 2.77*10!E10!N ; ; Revision : Jan 26 1999 Works also for Exponential values ; ; ; ; Silvio Giordano ; ;-----------------------------------------------------------------------------; Function APPROX,numero,decimali,STRG=STR res=STRCOMPRESS(numero,/rem) q=where(res eq 'NaN',cnt) if cnt ne 0 then begin if STR ne 'YES' then res=FLOAT(res) RETURN,res endif pos_dot=STRPOS(res,'.') pos_e=STRPOS(res,'e') if pos_e(0) ne -1 then begin ;APPROX on Exponential Number ' esp=FIX(ALOG10(numero)) num=numero/(10.^esp) if esp lt 0 then decimali=decimali+1 decim=FLOAT(decimali) res_num=STRCOMPRESS(ROUND(num*10.^(decim))/10.^(decim),/rem) pos_dot=STRPOS(res_num,'.') res_num=STRMID(res_num,0,pos_dot+decim+1) res=res_num*10.^(esp) ; string output for plot if STR eq 'YES' then begin if esp lt 0 then begin esp=esp-1 res_num=STRCOMPRESS(res_num*10.,/rem) res_num=STRMID(res_num,0,pos_dot+decim) endif res=STRCOMPRESS(res_num,/rem)+'!9X!3!N10!E'+STRCOMPRESS(esp,/rem)+'!N' endif RETURN,res endif ;APPROX on Floating Number' decimali=FLOAT(decimali) res=STRCOMPRESS(ROUND(numero*10.^(decimali))/10.^(decimali),/rem) pos_dot=STRPOS(res,'.') if decimali lt 0 then decimali=0 for i=0,N_ELEMENTS(numero)-1 do begin if decimali eq 0 then res(i)=STRMID(res(i),0,pos_dot(i)+decimali) $ else res(i)=STRMID(res(i),0,pos_dot(i)+decimali+1) endfor if STR ne 'YES' then if decimali eq 0 then res=FIX(res) else res=FLOAT(res) RETURN,res end ; ; ;------------------------------------------------------------------------- ; Convert date/time between REAL and STRING formats. ;------------------------------------------------------------------------- function UVCS_DATE_CONV,date,type ; ; Note: This is a modified version of the routine DATE_CONV contained ; in the Astronomy library. (The VECTOR format is not allowed in ; this version.) ; ; History: ; Original version 1 by D. Lindler July, 1987 ; Adapted for IDL version 2 by J. Isensee May, 1990 ; Adapted for SOHO/UVCS by A. van Ballegooijen January, 1996 ; ; Procedure to perform conversion of dates to one of TWO possible ; formats: ; ; format 1: real*8 scalar encoded as: ; date = (year-1900)*1000 + day + hour/24 + minute/24/60 ; + sec/24/60/60 + frc/24/60/60/100 ; where day is the day of year (1 to 366) ; format 2: string (ascii text) encoded as DD-MON-YEAR HH:MM:SS.SS ; (eg. 14-JUL-1987 15:25:44.23) ; ; Inputs: ; ; date - input date/time in one of the three possible formats. ; type - type of output format desired. If not supplied then ; format 3 (real*8 scalar) is used. Valid values: ; 'REAL' - format 1 ; 'STRING' - format 2 ; type can be abbreviated to the single character strings 'R' ; and 'S'. ; ; The converted date is returned as the function value. ; ;------------------------------------------------------------- ; ; 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'] out=0 ; ; Determine type of input supplied: ; s = size(date) & ndim = s(0) & datatype = s(ndim+1) form=0 if ndim eq 0 then begin if datatype eq 7 then form = 2 $ ; string input else form = 1 ; numeric scalar input endif if form eq 0 then begin POP_UP,'Error','UVCS_DATE_CONV -- invalid input date specified' return,out endif ; ; Verify output type specification is a string: ; if n_params(0) lt 2 then type = 'REAL' s = size(type) if (s(0) ne 0) or (s(1) ne 7) then begin POP_UP,'Error','UVCS_DATE_CONV -- Output type specification must be a string' return,out endif ; ; Convert input to year,day,hour,minute,second: ; if form eq 2 then begin ; STRING input temp = date day_of_month = fix(gettok(temp,'-')) month_name = gettok(temp,'-') year = fix(gettok(temp,' ')) hour = fix(gettok(temp,':')) minute = fix(gettok(temp,':')) sec = fix(gettok(temp,'.')) frc = fix(temp) if (fix(year) mod 4) eq 0 then days(2) = 29 month_name = strupcase(month_name) mon=0 for i = 1,12 do begin if month_name eq months(i) then mon=i endfor if mon eq 0 then begin POP_UP,'Error','UVCS_DATE_CONV -- invalid month name specified' return,out endif day = fix(total(days(0:mon-1))+day_of_month) endif else begin ; REAL input idate = long(date) year = fix(idate/1000) day = fix(idate-long(year)*1000) jdate = long((date-double(idate))*8640000.d0 + 0.1d0) hour = fix(jdate/360000) jdate = jdate - long(hour)*360000 minute = fix(jdate/6000) jdate = jdate - long(minute)*6000 sec = fix(jdate/100) jdate = jdate - long(sec)*100 frc = fix(jdate) if (fix(year) mod 4) eq 0 then days(2) = 29 daytot=total(days) if (day lt 1) or (day gt daytot) then begin num1=strcompress(daytot) num2=strcompress(year) POP_UP,'Error','UVCS_DATE_CONV -- There are only '+num1+' in year '+num2 return,out endif day_of_month = day month_num = 1 while day_of_month gt days(month_num) do begin day_of_month = day_of_month - days(month_num) month_num = month_num+1 endwhile month_name = months(month_num) endelse ; ; Convert to output format: ; case strmid(strupcase(type),0,1) of 'R': begin ; REAL output if year gt 1900 then year = year-1900 out = year*1000.d0 + day + $ (hour + (minute + (sec + frc/100.d0)/60.d0)/60.d0)/24.d0 end 'S': begin ; STRING output if year lt 1900 then year = year+1900 out = string(day_of_month,month_name,year,hour,minute,sec,frc, $ format='(i2.2,"-",a,"-",i4.4," ",i2.2,":",i2.2,":",i2.2,".",i2.2)') end else: begin POP_UP,'Error',['UVCS_DATE_CONV -- Invalid output type specified', $ 'It must be REAL or STRING'] return,out end endcase return,out end ; ; function CURVEFIT_S, x, y, w, a, sigmaa, Function_Name = Function_Name, $ itmax=itmax, iter=iter, tol=tol, chi2=chi2, $ noderivative=noderivative ;+ ; NAME: ; CURVEFIT_S ; ; PURPOSE: ; Revised by IDL Library Function /opt/idl4/idl_4/lib/curvefit.pro ; ; DOCUMENTATION: ; see CURVEFIT ; ; called by: ; MY_GAUSS ; ; MODIFICATION HISTORY: ; Apr 30 1997 ; May 17 1997 ; May 28 1997 ; Feb 28 2002 chi2 =0 if 'Failed to converge' ; ; AUTHOR: ; Silvio Giordano ;- ; ============================================================================== ; on_error,2 ;Return to caller if error ;Name of function to fit if n_elements(function_name) le 0 then function_name = "FUNCT" if n_elements(tol) eq 0 then tol = 1.e-3 ;Convergence tolerance if n_elements(itmax) eq 0 then itmax = 20 ;Maximum # iterations type = size(a) type = type(type(0)+1) double = type eq 5 if (type ne 4) and (type ne 5) then a = float(a) ;Make params floating ; If we will be estimating partial derivatives then compute machine precision if keyword_set(NODERIVATIVE) then begin res = nr_machar(DOUBLE=double) eps = sqrt(res.eps) endif nterms = n_elements(a) ; # of parameters nfree = n_elements(y) - nterms ; Degrees of freedom if nfree le 0 then message, 'Curvefit - not enough data points.' flambda = 0.001 ;Initial lambda diag = lindgen(nterms)*(nterms+1) ; Subscripts of diagonal elements ;Define the partial derivative array if double then pder = dblarr(n_elements(y), nterms) $ else pder = fltarr(n_elements(y), nterms) ; for iter = 1, itmax do begin ; Iteration loop ;Evaluate alpha and beta matricies. if keyword_set(NODERIVATIVE) then begin ;Evaluate function and estimate partial derivatives call_procedure, Function_name, x, a, yfit for term=0, nterms-1 do begin p = a ; Copy current parameters ; Increment size for forward difference derivative inc = eps * abs(p(term)) if (inc eq 0.) then inc = eps p(term) = p(term) + inc call_procedure, function_name, x, p, yfit1 pder(0,term) = (yfit1-yfit)/inc endfor endif else begin ; The user's procedure will return partial derivatives call_procedure, function_name, x, a, yfit, pder endelse beta = (y-yfit)*w # pder alpha = transpose(pder) # (w # (fltarr(nterms)+1)*pder) chisq1 = total(w*(y-yfit)^2)/nfree ; Present chi squared. ; If a good fit, no need to iterate all_done = chisq1 lt total(abs(y))/1e7/NFREE ; ;Invert modified curvature matrix to find new parameters. repeat begin ; silvio 1a qqq=alpha(diag) # alpha(diag) if min(qqq) lt 0 then begin print,' a - Unrecoverable Failure to Fit !!' yfit(*)=0 & chi2=0 & a(*)=1 goto, out endif if alpha(0,0) eq 'Inf' OR alpha(0,0) eq 'NaN' then begin print,' b - Failure to Fit !!' yfit(*)=0 & chi2=1 & a(*)=1 goto, out endif c = sqrt(qqq) if c(0,0) eq 'Inf' OR c(0,0) eq 'NaN' then begin print,' c - Failure to Fit !!' yfit(*)=0 & chi2=1 & a(*)=1 goto, out endif if min(c) eq 0 then begin print,' d - Failure to Fit !!' yfit(*)=0 & chi2=1 & a(*)=1 goto, out endif ; silvio 1b array = alpha/c array(diag) = array(diag)*(1.+flambda) array = invert(array) b = a+ array/c # transpose(beta) ; New params call_procedure, function_name, x, b, yfit ; Evaluate function chisqr = total(w*(y-yfit)^2)/nfree ; New chisqr if all_done then goto, done flambda = flambda*10. ; Assume fit got worse endrep until chisqr le chisq1 flambda = flambda/100. ; Decrease flambda by factor of 10 a=b ; Save new parameter estimate. if ((chisq1-chisqr)/chisq1) le tol then goto,done ; Finished? endfor ;iteration loop ; message, 'Failed to converge', /INFORMATIONAL chi2=0 ; done: sigmaa = sqrt(array(diag)/alpha(diag)) ; Return sigma's chi2 = chisqr ; Return chi-squared out: return,yfit ;return result end ; ; ;------------------------------------------------------------------------- ; Write Spectral & Visible Light (SPVL) Data File: ;------------------------------------------------------------------------- pro SPA_WR_SPVL,ws,stat,path,file ; stat1=strmid(stat,0,3) if stat1 ne 'sp_' and stat1 ne 'vl_' then begin POP_UP,'Error',' Not an SPVL data set ' return endif ; ; Warning: could be not possible read FITS with a panel ; which contains a single column of data. id=WHERE(ws.k.tdim(1,*) gt 0) tmp=ws.k.tdim(1,id) if MIN(tmp) eq 1 then begin txt0=' ' txt1=' It will be not possible read this FITS ' txt2=' which contains a single column panel, sorry ! ' txt3=' Do not collapse the panels along the spectral direction ' txt=[txt0,txt1,txt2,txt0,txt3,txt0] POP_UP,'Code Bug',txt return endif ;cb97 end ; ; Select path and extension: ; str=gettok(file,'.') & file=str+'.'+file & n=strlen(str)-2 root=strmid(file,0,n+22) m=strlen(file) if m gt n+25 then ext=strmid(file,n+25,m-n-25) else ext='' ;.new FILE_EXTENS,stat2,path,ext if stat2 eq 'Cancel' then return ; ; Generate new file name: ; stat1=strmid(stat,0,6) if stat1 eq 'sp_drk' then typ='drk' else $ if stat1 eq 'sp_flt' then typ='flt' else $ if stat1 eq 'sp_wav' then typ='wav' else $ if stat1 eq 'sp_wav_bck' then typ='wav' else $ if stat1 eq 'sp_rad' then typ='rad' else $ if stat1 eq 'vl_rad' then typ='rad' else typ='dat' file=root+typ+ext filez=file+'.Z' ;cbdc97 ; ; Avoid to Overwrite Existing Fits ; spawn , 'ls '+path, list, /sh ;added /sh DP 11/00 a=where(list eq file, cnt) a=where(list eq filez, cntz) ;cbdc97 ans='' if cnt ne 0 OR cntz ne 0 then begin title='Warning' text='You Are Overwriting a Fits on '+path POP_UP_OK,title,text,ans if ans eq 'Cancel' then return endif ; ws.k.path=path ; ; If instrument configuration is uncalibrated, then reset calibration ; parameter file name to 'None': ; if stat eq 'sp_raw' or stat eq 'sp_drk' or $ stat eq 'sp_flt' or stat eq 'vl_raw' then begin ws.k.cal_file='None' endif ; ; Write file: ; UVCS_FITS_WRITE,ws,stat,path,file end ;------------------------------------------------------------------------- ; Write Flat Field Data File: ;------------------------------------------------------------------------- pro SPA_WR_FLAT,ws,stat,path,file ; if stat ne 'flat_field' then begin POP_UP,'Error','Not a FLAT FIELD data set' return endif ; ; Select path and extension: ; path='../FLAT/' str=gettok(file,'.') & file=str+'.'+file & n=strlen(str)-2 root_typ=strmid(file,0,n+25) m=strlen(file) if m gt n+25 then ext=strmid(file,n+25,m-n-25) else ext='' ;.new FILE_EXTENS,stat2,path,ext if stat2 eq 'Cancel' then return ws.k.path=path file=root_typ+ext ; ; Write file: ; UVCS_FITS_WRITE,ws,stat,path,file end ;------------------------------------------------------------------------- ; Write Dark Count Data File: ;------------------------------------------------------------------------- pro SPA_WR_DARK,ws,stat,path,file ; if stat ne 'dark_count' then begin POP_UP,'Error','Not a DARK COUNT data set' return endif ; ; Select path and extension: ; path='../DARK/' str=gettok(file,'.') & file=str+'.'+file & n=strlen(str)-2 root_typ=strmid(file,0,n+25) m=strlen(file) if m gt n+25 then ext=strmid(file,n+25,m-n-25) else ext='' ;.new FILE_EXTENS,stat2,path,ext if stat2 eq 'Cancel' then return ws.k.path=path file=root_typ+ext ; ; Write file: ; UVCS_FITS_WRITE,ws,stat,path,file end ;------------------------------------------------------------------------- ; Write FITS File: ;-------------------------------------------------------------------------; pro UVCS_FITS_WRITE,ws,stat,path,file ; widget_control,ws.k.wid_main,/hourglass ; ; Create FITS Primary Header: ; fxhmake,primary_header,/extend,/date ; ; Write keywords for Spectral & VL Data, Flat Field Data ; and Dark Count Data files. ; ws.k.file =file ws.k.filename=file fxaddpar,primary_header,'FILENAME',ws.k.filename fxaddpar,primary_header,'TLM_FILE',ws.k.tlm_file fxaddpar,primary_header,'EXT' ,ws.k.ext fxaddpar,primary_header,'ORIGIN' ,ws.k.origin fxaddpar,primary_header,'TELESCOP',ws.k.telescop fxaddpar,primary_header,'INSTRUME',ws.k.instrume fxaddpar,primary_header,'DETECTOR',ws.k.detector fxaddpar,primary_header,'EXCON' ,ws.k.excon fxaddpar,primary_header,'EXPCOUNT',ws.k.expcount fxaddpar,primary_header,'TAI_OBS' ,ws.k.tai_obs,format='f14.3' fxaddpar,primary_header,'TAI_END' ,ws.k.tai_end,format='f14.3' fxaddpar,primary_header,'DATE_OBS',ws.k.date_obs fxaddpar,primary_header,'DATE_END',ws.k.date_end fxaddpar,primary_header,'STATUS' ,ws.k.status ; ; Write keywords present only for Spectral & VL Data files: ; if ws.k.ext eq 'DET_UV' or ws.k.ext eq 'DET_VL' then begin fxaddpar,primary_header,'SC_STAT' ,ws.k.sc_stat if ws.k.ext eq 'DET_UV' then begin fxaddpar,primary_header,'FLT_FILE',ws.k.flt_file fxaddpar,primary_header,'DRK_FILE',ws.k.drk_file endif fxaddpar,primary_header,'CAL_FILE',ws.k.cal_file fxaddpar,primary_header,'ORB_FILE',ws.k.orb_file fxaddpar,primary_header,'ATT_FILE',ws.k.att_file fxaddpar,primary_header,'OBS_NUM' ,ws.k.obs_num fxaddpar,primary_header,'OBS_TYPE',ws.k.obs_type ; Background keywords if ws.k.ext eq 'DET_UV' then begin fxaddpar,primary_header,'TDIM_BCK',ws.k.tdim_bck fxaddpar,primary_header,'TRVAL_B',ws.k.trval_bck fxaddpar,primary_header,'TDELT_B',ws.k.tdelt_bck fxaddpar,primary_header,'BCK_REM',ws.k.bck_rem endif endif fxwrite,path+file,primary_header ; ; Create Binary Table Extension header: ; if ws.k.ext eq 'DET_UV' then comment='EUV Detector Data (Spectra)' if ws.k.ext eq 'DET_VL' then comment='Visible Light Detector Data' if ws.k.ext eq 'FLAT' then comment='Flat Field Data' if ws.k.ext eq 'DARK' then comment='Dark Count Data' fxbhmake,header,ws.k.expcount,ws.k.ext,comment ; ; Define columns for raw configuration data: ; if ws.k.ext eq 'DET_UV' or ws.k.ext eq 'DET_VL' then begin fxbaddcol,col_dat_xobs,header,ws.f(0).dat_xobs,'DAT_XOBS' fxbaddcol,col_dat_xend,header,ws.f(0).dat_xend,'DAT_XEND' fxbaddcol,col_oblk ,header,ws.f(0).oblk ,'OBLK' fxbaddcol,col_buffer ,header,ws.f(0).buffer ,'BUFFER' fxbaddcol,col_roll ,header,ws.f(0).roll ,'ROLL' fxbaddcol,col_ptgx1 ,header,ws.f(0).ptgx1 ,'PTGX1' fxbaddcol,col_ptgx2 ,header,ws.f(0).ptgx2 ,'PTGX2' fxbaddcol,col_sunvt ,header,ws.f(0).sunvt ,'SUNVT' fxbaddcol,col_sunvb ,header,ws.f(0).sunvb ,'SUNVB' fxbaddcol,col_sunvr ,header,ws.f(0).sunvr ,'SUNVR' fxbaddcol,col_sunvl ,header,ws.f(0).sunvl ,'SUNVL' fxbaddcol,col_mirpos ,header,ws.f(0).mirpos ,'MIRPOS' fxbaddcol,col_occpos ,header,ws.f(0).occpos ,'OCCPOS' fxbaddcol,col_fltpos ,header,ws.f(0).fltpos ,'FLTPOS' fxbaddcol,col_sc_y ,header,ws.f(0).sc_y ,'SC_Y' fxbaddcol,col_sc_z ,header,ws.f(0).sc_z ,'SC_Z' fxbaddcol,col_sc_roll ,header,ws.f(0).sc_roll ,'SC_ROLL' if ws.k.ext eq 'DET_UV' then begin fxbaddcol,col_tai_xobs,header,ws.f(0).tai_xobs,'TAI_XOBS' fxbaddcol,col_exptime ,header,ws.f(0).exptime ,'EXPTIME' fxbaddcol,col_sltpos ,header,ws.f(0).sltpos ,'SLTPOS' fxbaddcol,col_grtpos ,header,ws.f(0).grtpos ,'GRTPOS' fxbaddcol,col_mcpv ,header,ws.f(0).mcpv ,'MCPV' endif else begin fxbaddcol,col_vlenum ,header,ws.f(0).vlenum ,'VLENUM' fxbaddcol,col_vlhv ,header,ws.f(0).vlhv ,'VLHV' fxbaddcol,col_vlstrt ,header,ws.f(0).vlstrt ,'VLSTRT' fxbaddcol,col_vlexp ,header,ws.f(0).vlexp ,'VLEXP' fxbaddcol,col_vlcnt ,header,ws.f(0).vlcnt ,'VLCNT' fxbaddcol,col_vlmode ,header,ws.f(0).vlmode ,'VLMODE' fxbaddcol,col_vlrad1 ,header,ws.f(0).vlrad1 ,'VLRAD1' fxbaddcol,col_vlrad2 ,header,ws.f(0).vlrad2 ,'VLRAD2' fxbaddcol,col_polpos ,header,ws.f(0).polpos ,'POLPOS' endelse ; ; Define columns for calibrated configuration data: ; if stat eq 'sp_raw_conf' or stat eq 'sp_drk_conf' or $ stat eq 'sp_flt_conf' or stat eq 'sp_wav_bck' or $ stat eq 'sp_wav' or stat eq 'sp_rad' or $ stat eq 'vl_raw_conf' or stat eq 'vl_rad' then begin fxbaddcol,col_rolangl ,header,ws.f(0).rolangl ,'ROLANGL' fxbaddcol,col_posx1 ,header,ws.f(0).posx1 ,'POSX1' fxbaddcol,col_posx2 ,header,ws.f(0).posx2 ,'POSX2' fxbaddcol,col_mirangl ,header,ws.f(0).mirangl ,'MIRANGL' fxbaddcol,col_cmdmir ,header,ws.f(0).cmdmir ,'CMDMIR' fxbaddcol,col_occwdth ,header,ws.f(0).occwdth ,'OCCWDTH' fxbaddcol,col_ins_roll,header,ws.f(0).ins_roll,'INS_ROLL' fxbaddcol,col_ins_y0 ,header,ws.f(0).ins_y0 ,'INS_Y0' fxbaddcol,col_ins_z0 ,header,ws.f(0).ins_z0 ,'INS_Z0' fxbaddcol,col_sc_yr ,header,ws.f(0).sc_yr ,'SC_YR' fxbaddcol,col_sc_zr ,header,ws.f(0).sc_zr ,'SC_ZR' fxbaddcol,col_ins_yr ,header,ws.f(0).ins_yr ,'INS_YR' fxbaddcol,col_sun_yr ,header,ws.f(0).sun_yr ,'SUN_YR' fxbaddcol,col_sun_zr ,header,ws.f(0).sun_zr ,'SUN_ZR' if strmid(stat,0,3) eq 'sp_' then begin fxbaddcol,col_sltwdth,header,ws.f(0).sltwdth,'SLTWDTH' fxbaddcol,col_mcpvolt,header,ws.f(0).mcpvolt,'MCPVOLT' if stat eq 'sp_wav' or stat eq 'sp_wav_bck' or stat eq 'sp_rad' then begin fxbaddcol,col_wrval,header,ws.f(0).wrval ,'WRVAL' fxbaddcol,col_wdelt,header,ws.f(0).wdelt ,'WDELT' endif endif else begin fxbaddcol,col_polangl,header,ws.f(0).polangl,'POLANGL' fxbaddcol,col_vlhvolt,header,ws.f(0).vlhvolt,'VLHVOLT' if stat eq 'vl_rad' then begin fxbaddcol,col_stokes_i,header,ws.f(0).stokes_i,'STOKES_I' fxbaddcol,col_stokes_q,header,ws.f(0).stokes_q,'STOKES_Q' fxbaddcol,col_stokes_u,header,ws.f(0).stokes_u,'STOKES_U' fxbaddcol,col_pb,header,ws.f(0).pb,'pB' ;cb97 fxbaddcol,col_pberr,header,ws.f(0).pberr,'pB_ERR' ;cb97 fxbaddcol,col_pbang,header,ws.f(0).pbang,'ANGLE' ;cb97 fxbaddcol,col_pbangerr,header,ws.f(0).pbangerr,'ANGLE_ERR' ;cb97 endif endelse endif endif ; ; Write keywords present only for XDL-related data (Spectral Data, ; Flat Field or Dark Count files): ; if ws.k.ext eq 'FLAT' or ws.k.ext eq 'DARK' or $ ws.k.ext eq 'DET_UV' then begin ; ; 1) Original masking/binning parameters: ; fxaddpar,header,'ROWNGRP ',ws.k.rowngrp fxaddpar,header,'ROWFRST ',ws.k.rowfrst fxaddpar,header,'ROWACT ',ws.k.rowact fxaddpar,header,'ROWSPC ',ws.k.rowspc fxaddpar,header,'NPANEL ',ws.k.npanel for n=0,ws.k.npanel-1 do begin number=strcompress(n,/remove_all) fxaddpar,header,'COLNGRP'+number,ws.k.colngrp(n) fxaddpar,header,'COLFRST'+number,ws.k.colfrst(n) fxaddpar,header,'COLACT'+number ,ws.k.colact(n) fxaddpar,header,'COLSPC'+number ,ws.k.colspc(n) endfor fxaddpar,header,'UVOFST',ws.k.uvofst fxaddpar,header,'UVBCNT',ws.k.uvbcnt fxaddpar,header,'UVTABL',ws.k.uvtabl ; ; 2) Data coordinate keywords: ; fxaddpar,header,'NDATA' ,ws.k.ndata trpix='( 1, 1)' col_data=lonarr(ws.k.ndata) for n=0,ws.k.ndata-1 do begin number=strcompress(n,/remove_all) tdesc=string(ws.k.tdesc(0,0),ws.k.tdesc(1,n),'("(",a,",",a,")")') if stat eq 'sp_wav' or stat eq 'sp_wav_bck' or stat eq 'sp_rad' then begin trval=string(ws.k.trval(0,0),ws.k.trval(1,n),'("(",f6.0,",",f6.1,")")') tdelt=string(ws.k.tdelt(0,0),ws.k.tdelt(1,n),'("(",f6.2,",",f6.1,")")') tsize=string(ws.k.tsize(0,0),ws.k.tsize(1,n),'("(",f6.2,",",f6.1,")")') endif else begin trval=string(ws.k.trval(0,0),ws.k.trval(1,n),'("(",f5.1,",",f6.1,")")') tdelt=string(ws.k.tdelt(0,0),ws.k.tdelt(1,n),'("(",f5.1,",",f6.1,")")') tsize=string(ws.k.tsize(0,0),ws.k.tsize(1,n),'("(",f5.1,",",f6.1,")")') endelse data=fltarr(ws.k.tdim(0,0),ws.k.tdim(1,n)) fxbaddcol,col,header,data,'DATA'+number col_data(n)=col colnum=strcompress(col,/remove_all) fxaddpar,header,'TDESC'+colnum,tdesc fxaddpar,header,'TRPIX'+colnum,trpix fxaddpar,header,'TRVAL'+colnum,trval fxaddpar,header,'TDELT'+colnum,tdelt fxaddpar,header,'TSIZE'+colnum,tsize fxaddpar,header,'TRCAL'+colnum,ws.k.trcal(n) endfor if ws.k.tdim_bck ne 0 then begin databck=fltarr(ws.k.tdim(0,0)) fxbaddcol,colbck,header,databck,'DATA_BCK' endif endif ; ; 3) Read y-coordinate of line-of-sight to reference point on the ; entrance slit: ; if stat eq 'sp_raw_conf' or stat eq 'sp_drk_conf' or $ stat eq 'sp_flt_conf' or stat eq 'sp_wav_bck' or $ stat eq 'sp_wav' or stat eq 'sp_rad' or $ stat eq 'vl_raw_conf' or stat eq 'vl_rad' then $ fxaddpar,header,'INS_ZR',ws.k.ins_zr ; ; Write extension header: ; fxbcreate,unit,path+file,header ; ; Loop over all exposures: ; for i=0,ws.k.expcount-1 do begin row=i+1 ; ; Write basic configuration data: ; if ws.k.ext eq 'DET_UV' or ws.k.ext eq 'DET_VL' then begin fxbwrite,unit,ws.f(i).dat_xobs,col_dat_xobs,row fxbwrite,unit,ws.f(i).dat_xend,col_dat_xend,row fxbwrite,unit,ws.f(i).oblk ,col_oblk ,row fxbwrite,unit,ws.f(i).buffer ,col_buffer ,row fxbwrite,unit,ws.f(i).roll ,col_roll ,row fxbwrite,unit,ws.f(i).ptgx1 ,col_ptgx1 ,row fxbwrite,unit,ws.f(i).ptgx2 ,col_ptgx2 ,row fxbwrite,unit,ws.f(i).sunvt ,col_sunvt ,row fxbwrite,unit,ws.f(i).sunvb ,col_sunvb ,row fxbwrite,unit,ws.f(i).sunvr ,col_sunvr ,row fxbwrite,unit,ws.f(i).sunvl ,col_sunvl ,row fxbwrite,unit,ws.f(i).mirpos ,col_mirpos ,row fxbwrite,unit,ws.f(i).occpos ,col_occpos ,row fxbwrite,unit,ws.f(i).fltpos ,col_fltpos ,row fxbwrite,unit,ws.f(i).sc_y ,col_sc_y ,row fxbwrite,unit,ws.f(i).sc_z ,col_sc_z ,row fxbwrite,unit,ws.f(i).sc_roll ,col_sc_roll ,row if ws.k.ext eq 'DET_UV' then begin fxbwrite,unit,ws.f(i).tai_xobs,col_tai_xobs,row fxbwrite,unit,ws.f(i).exptime ,col_exptime ,row fxbwrite,unit,ws.f(i).sltpos ,col_sltpos ,row fxbwrite,unit,ws.f(i).grtpos ,col_grtpos ,row fxbwrite,unit,ws.f(i).mcpv ,col_mcpv ,row endif else begin fxbwrite,unit,ws.f(i).vlenum ,col_vlenum ,row fxbwrite,unit,ws.f(i).vlhv ,col_vlhv ,row fxbwrite,unit,ws.f(i).vlstrt ,col_vlstrt ,row fxbwrite,unit,ws.f(i).vlexp ,col_vlexp ,row fxbwrite,unit,ws.f(i).vlcnt ,col_vlcnt ,row fxbwrite,unit,ws.f(i).vlmode ,col_vlmode ,row fxbwrite,unit,ws.f(i).vlrad1 ,col_vlrad1 ,row fxbwrite,unit,ws.f(i).vlrad2 ,col_vlrad2 ,row fxbwrite,unit,ws.f(i).polpos ,col_polpos ,row endelse ; ; Write calibrated configuration data: ; if stat eq 'sp_raw_conf' or stat eq 'sp_drk_conf' or $ stat eq 'sp_flt_conf' or stat eq 'sp_wav' or $ stat eq 'sp_wav_bck' or stat eq 'sp_rad' or $ stat eq 'vl_raw_conf' or stat eq 'vl_rad' then begin fxbwrite,unit,ws.f(i).rolangl ,col_rolangl ,row fxbwrite,unit,ws.f(i).posx1 ,col_posx1 ,row fxbwrite,unit,ws.f(i).posx2 ,col_posx2 ,row fxbwrite,unit,ws.f(i).mirangl ,col_mirangl ,row fxbwrite,unit,ws.f(i).cmdmir ,col_cmdmir ,row fxbwrite,unit,ws.f(i).occwdth ,col_occwdth ,row fxbwrite,unit,ws.f(i).ins_roll,col_ins_roll,row fxbwrite,unit,ws.f(i).ins_y0 ,col_ins_y0 ,row fxbwrite,unit,ws.f(i).ins_z0 ,col_ins_z0 ,row fxbwrite,unit,ws.f(i).sc_yr ,col_sc_yr ,row fxbwrite,unit,ws.f(i).sc_zr ,col_sc_zr ,row fxbwrite,unit,ws.f(i).ins_yr ,col_ins_yr ,row fxbwrite,unit,ws.f(i).sun_yr ,col_sun_yr ,row fxbwrite,unit,ws.f(i).sun_zr ,col_sun_zr ,row if strmid(stat,0,3) eq 'sp_' then begin fxbwrite,unit,ws.f(i).sltwdth ,col_sltwdth ,row fxbwrite,unit,ws.f(i).mcpvolt ,col_mcpvolt ,row if stat eq 'sp_wav' or stat eq 'sp_wav_bck' or stat eq 'sp_rad' then begin fxbwrite,unit,ws.f(i).wrval,col_wrval ,row fxbwrite,unit,ws.f(i).wdelt,col_wdelt ,row endif endif else begin fxbwrite,unit,ws.f(i).polangl ,col_polangl ,row fxbwrite,unit,ws.f(i).vlhvolt ,col_vlhvolt ,row if stat eq 'vl_rad' then begin fxbwrite,unit,ws.f(i).stokes_i,col_stokes_i,row fxbwrite,unit,ws.f(i).stokes_q,col_stokes_q,row fxbwrite,unit,ws.f(i).stokes_u,col_stokes_u,row fxbwrite,unit,ws.f(i).pb,col_pb,row ;cb97 fxbwrite,unit,ws.f(i).pberr,col_pberr,row ;cb97 fxbwrite,unit,ws.f(i).pbang,col_pbang,row ;cb97 fxbwrite,unit,ws.f(i).pbangerr,col_pbangerr,row ;cb97 endif endelse endif endif ; ; Write count, intensity, field field or dark count data: ; if ws.k.ext eq 'FLAT' or ws.k.ext eq 'DARK' or $ ws.k.ext eq 'DET_UV' then begin for n=0,ws.k.ndata-1 do $ fxbwrite,unit,ws.d(*,ws.k.en(n):ws.k.en(n+1)-1,i),col_data(n),row endif ; ; Write background array if ws.k.ext eq 'DET_UV' then begin if ws.k.tdim_bck ne 0 then fxbwrite,unit,ws.b(*,i),colbck,row endif ; ; End loop over exposures. ; endfor fxbfinish,unit comp='compress -f '+path+file print,comp spawn,comp, /sh ; added /sh DP 11/00 end ;------------------------------------------------------------------------- ; Dark Count correction: ;------------------------------------------------------------------------- pro SP2_CAL_DARK,ws,stat,path,file,wsb,stat_b,path_b,file_b ; ; Verify input: ; if strmid(stat,0,6) ne 'sp_raw' then begin POP_UP,'Error','Dark count correction allowed only for raw spectral data' return endif if stat_b ne 'dark_count' then begin POP_UP,'Error','Data set B must contain Dark Count data' return endif if wsb.k.detector ne ws.k.detector then begin POP_UP,'Error',' Not a '+ws.k.detector+' Dark Count file' return endif ; ; Generate full-scale dark count image: ; dark_array=fltarr(360,1024) imax=wsb.k.tdim(0,0) drow=0.5*(wsb.k.tsize(0,0)-1.0) nr1=nint(wsb.k.trval(0,0)+indgen(imax)*wsb.k.tdelt(0,0)-drow) nr2=nint(wsb.k.trval(0,0)+indgen(imax)*wsb.k.tdelt(0,0)+drow) for n=0,wsb.k.ndata-1 do begin dcol=0.5*(wsb.k.tsize(1,n)-1) area=wsb.k.tsize(0,0)*wsb.k.tsize(1,n) for jj=0,wsb.k.tdim(1,n)-1 do begin nc1=nint(wsb.k.trval(1,n)+jj*wsb.k.tdelt(1,n)-dcol) nc2=nint(wsb.k.trval(1,n)+jj*wsb.k.tdelt(1,n)+dcol) j=wsb.k.en(n)+jj for i=0,imax-1 do dark_array(nr1(i):nr2(i),nc1:nc2)=wsb.d(i,j,0)/area endfor endfor ; ; Rebin dark count image according to masking/binning parameters ; of spectral data, and perform dark count correction: ; imax=ws.k.tdim(0,0) drow=0.5*(ws.k.tsize(0,0)-1.0) nr1=nint(ws.k.trval(0,0)+indgen(imax)*ws.k.tdelt(0,0)-drow) nr2=nint(ws.k.trval(0,0)+indgen(imax)*ws.k.tdelt(0,0)+drow) for n=0,ws.k.ndata-1 do begin dcol=0.5*(ws.k.tsize(1,n)-1) for jj=0,ws.k.tdim(1,n)-1 do begin nc1=nint(ws.k.trval(1,n)+jj*ws.k.tdelt(1,n)-dcol) nc2=nint(ws.k.trval(1,n)+jj*ws.k.tdelt(1,n)+dcol) j=ws.k.en(n)+jj for i=0,imax-1 do begin dark_rate=total(dark_array(nr1(i):nr2(i),nc1:nc2)) ws.d(i,j,*)=ws.d(i,j,*)-dark_rate*ws.f.exptime endfor endfor endfor ; if stat eq 'sp_raw' then stat='sp_drk' if stat eq 'sp_raw_conf' then stat='sp_drk_conf' ws.k.status=stat ws.k.drk_path=wsb.k.path ws.k.drk_file=wsb.k.file end ;------------------------------------------------------------------------- ; Flat Field Correction: ;------------------------------------------------------------------------- pro SP2_CAL_FLAT,ws,stat,path,file,wsb,stat_b,path_b,file_b ; stat1=strmid(stat,0,6) if stat1 ne 'sp_raw' and stat1 ne 'sp_drk' then begin POP_UP,'Error', $ 'Flat field correction allowed only for raw or dark-count corrected data' return endif if stat_b ne 'flat_field' then begin POP_UP,'Error','Data set B must contain Flat Field data' return endif if wsb.k.detector ne ws.k.detector then begin POP_UP,'Error',' Not a '+ws.k.detector+' Flat Field file' return endif ; ; Generate full-scale flat field image: ; flat_array=fltarr(360,1024) imax=wsb.k.tdim(0,0) drow=0.5*(wsb.k.tsize(0,0)-1.0) nr1=nint(wsb.k.trval(0,0)+indgen(imax)*wsb.k.tdelt(0,0)-drow) nr2=nint(wsb.k.trval(0,0)+indgen(imax)*wsb.k.tdelt(0,0)+drow) for n=0,wsb.k.ndata-1 do begin dcol=0.5*(wsb.k.tsize(1,n)-1) for jj=0,wsb.k.tdim(1,n)-1 do begin nc1=nint(wsb.k.trval(1,n)+jj*wsb.k.tdelt(1,n)-dcol) nc2=nint(wsb.k.trval(1,n)+jj*wsb.k.tdelt(1,n)+dcol) j=wsb.k.en(n)+jj for i=0,imax-1 do flat_array(nr1(i):nr2(i),nc1:nc2)=wsb.d(i,j,0) endfor endfor ; ; Rebin flat field image according to masking/binning parameters ; of spectral data, and perform flat field correction: ; imax=ws.k.tdim(0,0) drow=0.5*(ws.k.tsize(0,0)-1.0) nr1=nint(ws.k.trval(0,0)+indgen(imax)*ws.k.tdelt(0,0)-drow) nr2=nint(ws.k.trval(0,0)+indgen(imax)*ws.k.tdelt(0,0)+drow) for n=0,ws.k.ndata-1 do begin dcol=0.5*(ws.k.tsize(1,n)-1) for jj=0,ws.k.tdim(1,n)-1 do begin nc1=nint(ws.k.trval(1,n)+jj*ws.k.tdelt(1,n)-dcol) nc2=nint(ws.k.trval(1,n)+jj*ws.k.tdelt(1,n)+dcol) j=ws.k.en(n)+jj for i=0,imax-1 do begin flat_factor=avg(flat_array(nr1(i):nr2(i),nc1:nc2)) ws.d(i,j,*)=ws.d(i,j,*)/flat_factor endfor endfor endfor ; if stat eq 'sp_raw' or stat eq 'sp_drk' then stat='sp_flt' if stat eq 'sp_raw_conf' or stat eq 'sp_drk_conf' then stat='sp_flt_conf' ws.k.status=stat ws.k.flt_path=wsb.k.path ws.k.flt_file=wsb.k.file end ;------------------------------------------------------------------------- ; Radiometric calibration: ; ; Oct 04 update for Neutral Density filter - S. Giordano ;------------------------------------------------------------------------- pro SPA_CAL_RAD,ws,stat,path,file common uvcs_rad,button,trcal,contin,cancel,stat1,order,button_order common wd_mn,wid_main ; ; ; Verify if you have the proper calibration : ; if strmid(stat,0,3) eq 'vl_' then begin POP_UP,' Please ', $ " Use 'Perform VL pB Computation' " return endif ; ; Verify calibration status: ; if stat ne 'sp_wav' AND stat ne 'sp_wav_bck' then begin POP_UP,'Error', $ 'Radiometric calibration allowed only for wavelength-calibrated data' return endif ; ; Verify if you have the proper calibration : ; ;spawn,'ls -1 ../CAL',lst, /sh ;added /sh DP 11/00 ;a=where(ws.k.cal_file eq lst,cnt) ;if cnt ne 1 then begin ; POP_UP,'Error','You Do Not Have the Proper Calibration File' ; return ;endif ; ; Create widget to select Primary or Redundant calibration: ; if ws.k.detector eq 'OVI' then begin base =widget_base(title='Radiometric Calibration', $ xoffset=300,yoffset=300,/column, /modal, group_leader = wid_main) ; 1st/2nd Order choice added, DP 11/00: order = 0 ;DP 11/00 label0 = widget_label(base,value='Select First or Second Order:') ;DP 11/00 button_order = cw_bgroup(base,['1st','2nd'],label_left = 'Order:',$ ;DP 11/00 set_value=0,/exclusive,/row) label=widget_label(base,value='Select Primary or Redundant Wavelengths:') button=lonarr(ws.k.ndata) trcal =intarr(ws.k.ndata) for n=0,ws.k.ndata-1 do begin text=string(n,format='("Panel nr. ",i2,":")') button(n)=cw_bgroup(base,['PRI','RED'],label_left=text, $ set_value=0,/exclusive,/row) endfor base1=widget_base(base,/row) contin=widget_button(base1,value='CONTINUE',resource_name='green') cancel=widget_button(base1,value=' CANCEL ',resource_name='green') widget_control,base,/realize xmanager,'cal_rad',base if stat1 eq 'Cancel' then return ws.k.trcal(0:ws.k.ndata-1)=trcal endif ; Added 1st/2nd Order choice for LYA, DP 11/00 if ws.k.detector eq 'LYA' then begin base = widget_base(title='Radiometric Calibration', $ xoffset=300,yoffset=300,/column, /modal, group_leader = wid_main) order = 0 ;DP 11/00 label0 = widget_label(base,value='Select First or Second Order:') ;DP 11/00 button_order = cw_bgroup(base,['1st','2nd'],label_left = 'Order:',$ ;DP 11/00 set_value=0,/exclusive,/row) base1=widget_base(base,/row) contin=widget_button(base1,value='CONTINUE',resource_name='green') cancel=widget_button(base1,value=' CANCEL ',resource_name='green') widget_control,base,/realize xmanager,'cal_rad_lya',base if stat1 eq 'Cancel' then return endif warn_text = '' ; ; Loop over all panels: ; for n=0,ws.k.ndata-1 do begin ; ; Determine calibration channel: ; i=ws.k.trcal(n) if ws.k.detector eq 'LYA' then det=2 else det=3+i if det eq 4 then begin wavnum =ws.c.(det).rad2.wavnum c_wavlen =ws.c.(det).rad2.wavlen c_eff_wave= ws.c.(det).rad2.eff_wave occnum =ws.c.(det).rad2.occnum c_eff_occ=ws.c.(det).rad2.eff_occ firstnum=ws.c.(det).rad2.firstnum c_firstpix=ws.c.(det).rad2.firstpix c_firstval=ws.c.(det).rad2.firstval lastnum=ws.c.(det).rad2.lastnum c_lastpix=ws.c.(det).rad2.lastpix c_lastval=ws.c.(det).rad2.lastval c_foclen =ws.c.(det).rad2.foclen endif else begin wavnum =ws.c.(det).rad1.wavnum c_wavlen =ws.c.(det).rad1.wavlen c_eff_wave =ws.c.(det).rad1.eff_wave occnum =ws.c.(det).rad1.occnum c_eff_occ=ws.c.(det).rad1.eff_occ c_foclen =ws.c.(det).rad1.foclen endelse ; ; Loop over exposures: ; for k=0,ws.k.expcount-1 do begin d_lambda=ws.k.tdelt(1,n)*ws.f(k).wdelt(i) const=4.848e-8*ws.k.tdelt(0,0)*abs(d_lambda)/c_foclen ; initialize leftmost wavelength in panel: leftmost_wave=ws.f(k).wrval(i) + (ws.k.trval(1,n))*ws.f(k).wdelt(i) highest_dubious_wave =0 ; initialize highest_dubious_wave, the last wavelength in the 10-50% gray ; zone for calibration no_redundant_somewhere = 0 ; we'll set this variable =1 if the user asks for a redundant panel ; calibration, but at least part of the panel is completely vignetted ; for the redundant region. ; initialize max_area, the maximum effective redundant area with this aperture max_aperture = ws.f(k).occwdth < 35 max_area = 0 for index = 0, occnum-1 do $ max_area = max_area + c_eff_occ(index)*max_aperture^index ; Loop over all wavelengths in one panel: ; the loop is in a negative direction because it makes dealing with ; redundant vignetting easier, since unvignetted area will occur first. for j=ws.k.tdim(1,n)-1, 0, -1 do begin ; calculate current wavelength: ; N.B. fixed an error calculating lambda DP 1/01 lambda=ws.f(k).wrval(i) + (ws.k.trval(1,n))*ws.f(k).wdelt(i) + j*d_lambda ; print, "lambda =", lambda ;test ; ; Determine parameters for interpolation of occulter positions: ; no_redundant = 0 ; no_redundant will be set = 1 for completely vignetted columns, so ; that they are blacked out in the display if det eq 4 then begin ; Calculate first occulter position that can contribute to redundant ; path at this pixel number (DP 12/00): currentpix = ws.k.trval(1,n) + j*ws.k.tdelt(1,n) ; print, "currentpix =", currentpix;test if currentpix lt c_firstpix(0) or $ currentpix gt c_firstpix(firstnum-1) then begin text=strarr(4) text(0)='No calibration available for this pixel:' text(1)=string(n ,'(" Panel: ",i3)') text(2)=string(k ,'(" Exposure: ",i3)') text(3)=string(currentpix,'(" Pixel: ",i3)') POP_UP,'Error',text return endif ifirst=0 while currentpix gt c_firstpix(ifirst+1) do ifirst=ifirst+1 delta=c_firstpix(ifirst+1) - c_firstpix(ifirst) ffirst0=(currentpix - c_firstpix(ifirst))/delta ffirst1=1.0-ffirst0 ; Calculate last occulter position that can contribute to redundant ; path at this pixel number (DP 12/00): if currentpix lt c_lastpix(0) or $ currentpix gt c_lastpix(lastnum-1) then begin text=strarr(4) text(0)='No calibration available for this pixel:' text(1)=string(n ,'(" Panel: ",i3)') text(2)=string(k ,'(" Exposure: ",i3)') text(3)=string(currentpix,'(" Pixel: ",i3)') POP_UP,'Error',text return endif ilast=0 while currentpix gt c_lastpix(ilast+1) do ilast=ilast+1 delta=c_lastpix(ilast+1) - c_lastpix(ilast) flast0=(currentpix - c_lastpix(ilast))/delta flast1=1.0-flast0 ; Calculate redundant OVI effective area: firstwdth = (ffirst1*c_firstval(ifirst) + $ ffirst0*c_firstval(ifirst+1)) lastwdth = (flast1*c_lastval(ilast) + $ flast0*c_lastval(ilast+1)) ; actual first contributing occwdth is maximum of firstwdth, 0 ; actual last contributing occwdth is minimum of lastwdth, occwdth occwdth = ws.f(k).occwdth actual_first = firstwdth > 0 actual_last = lastwdth < occwdth first_area = 0 last_area = 0 for index=0, occnum-1 do begin first_area = first_area + c_eff_occ(index)*actual_first^index last_area = last_area + c_eff_occ(index)*actual_last^index endfor ; update maximum area observed so far, so that we know when to warn ; and then drop out because of less reliable calibration area_occ = (last_area - first_area) ; 10% max area or less means that we're barely in or not in a redundant ; portion of the panel, so we'll set a flag and return a 0 ; brightness for the column, as the redundant calibration breaks down. if ((area_occ le max_area*0.1) or (area_occ le 0)) then begin no_redundant = 1 if no_redundant_somewhere eq 0 then highest_nored_wave = lambda endif else begin ; 10-50% max area and we'll give the user a warning about the calibration. if ((area_occ le max_area*0.5) and highest_dubious_wave eq 0) then begin highest_dubious_wave = lambda fractional_area = area_occ / max_area endif endelse endif if (det ne 4) then begin ; ; Non-redundant OVI or LYA detector effective area calculation: ; occwdth=ws.f(k).occwdth area_occ = 0 for index=0,occnum-1 do begin area_occ = area_occ + c_eff_occ(index)*occwdth^index endfor endif ; ; ; Determine parameters for interpolation in wavelength: ; if lambda lt c_wavlen(0) or $ lambda gt c_wavlen(wavnum-1) then begin text=strarr(4) text(0)='No calibration available for this wavelength:' text(1)=string(n ,'(" Panel: ",i3)') text(2)=string(k ,'(" Exposure: ",i3)') text(3)=string(lambda,'(" Wavelength: ",f7.2," Angstrom")') POP_UP,'Error',text return endif iwav=0 while lambda gt c_wavlen(iwav+1) do iwav=iwav+1 delta=c_wavlen(iwav+1) - c_wavlen(iwav) fwav0=(lambda - c_wavlen(iwav))/delta fwav1=1.0-fwav0 ; ; Convert to RADIANCE (DP 01) (photons/s/sm2/sterad/angstrom) at the UVCS ; entrance aperture: ; area = area_occ * (fwav1*c_eff_wave(iwav) + $ fwav0*c_eff_wave(iwav+1)) ; ; Neutral Density Filter ... if engaged ; SG 10/04 ; ndf_lambda=1. if ws.f(k).fltpos eq 2 then begin print,'' print,'Take into account the Neutral Density Filter transmission' ; print,' Some verification is necessary' print,'' ; ; From L. Gardner: ;Lab calibration (95.06) of OVI ND filter ==> ;T=0.00105 +/- 0.00008 at wavelength = 1236 A. ; ;On-Orbit calibration (96.12.04) of OVI ND filter ==> ;T=0.000891 +/- 0.000028 at wavelength = 1216 A. ; ;On-Orbit calibration (96.12.04) of LYA ND filter ==> ;T=0.001073 +/- 0.000029 at wavelength = 1216 A. ; ;"Typical" Magnesium Fluoride Transmission ;(from a graph in an Acton Research Catalog) wavel=[1100,1150,1200,1250,1300,1350,1400,1450,1500] trans=[ 0., .1, .38, .48, .65, .70, .74, .77, .80] ; ; transmission at 1216 A t1216=interpol(trans,wavel,1216) ; ; normalize to calibrated values the ; transmission as a function of wavelength if ws.k.detector eq 'LYA' then ndf_cal=0.001073 if ws.k.detector eq 'OVI' then ndf_cal=0.000891 trans_funct=trans *(ndf_cal/t1216) ; ; transmission at given wavelength ndf_lambda=interpol(trans_funct,wavel,lambda) endif factor=const*area*ws.f(k).exptime*ws.f(k).sltwdth*ndf_lambda if no_redundant eq 1 then begin ws.d(*,ws.k.en(n)+j,k)=0 no_redundant = 0 no_redundant_somewhere = 1 endif else begin if factor eq 0 then begin text=strarr(4) text(0)='No calibration available for this wavelength:' text(1)=string(n ,'(" Panel: ",i3)') text(2)=string(k ,'(" Exposure: ",i3)') text(3)=string(lambda,'(" Wavelength: ",f7.2," Angstrom")') POP_UP,'Error',text return endif else ws.d(*,ws.k.en(n)+j,k)=ws.d(*,ws.k.en(n)+j,k)/factor endelse endfor base_warn = strarr(8) base_warn(0)='Because of vignetting in the redundant LyA channel, some wavelengths of' base_warn(1)='data could not be calibrated, or were calibrated with greater than' base_warn(2)='typical uncertainty. Wavelengths with vignetting resulting' base_warn(3)='in less than 10% of maximum possible amplitude at current' base_warn(4)='occulter width could not be calibrated, and were set to zero.' base_warn(5)='Wavelengths vignetted to between 10% and 50% maximum have' base_warn(6)='greater than typical uncertainty in calibration. Details follow:' base_warn(7)='' if highest_dubious_wave ne 0 then begin text = string(n,k ,'("*** Panel: ",i2,", Exposure: ",i3)') if (size(warn_text))(0) eq 0 then begin warn_text=base_warn warn_text = [warn_text, text] endif else warn_text = [warn_text, text] if no_redundant_somewhere eq 1 then begin text=strarr(2) text(0)=string(leftmost_wave, highest_nored_wave,$ '(f7.2," to ",f7.2," Angstroms: < 10%, set to zero.")') text(1)=string(highest_nored_wave, highest_dubious_wave,$ '(f7.2," to ",f7.2," Angstroms: 10% to 50%")') warn_text = [warn_text, text, ' '] endif else begin text=strarr(1) text(0)=string(leftmost_wave,highest_dubious_wave,$ '(f7.2," to ",f7.2," Angstroms: 10% to 50%")') ; text(1)=string(fractional_area,'("Fraction of maximum at rightmost wavelength in panel:",f3.2)') if (size(warn_text))(0) eq 0 then begin warn_text = strarr(n_elements(text)+1) warn_text = [text] endif else warn_text = [warn_text, text,' '] endelse endif else begin if no_redundant_somewhere eq 1 then begin text = string(n, k ,'("*** Panel: ",i2,", Exposure: ",i3)') if (size(warn_text))(0) eq 0 then begin warn_text=base_warn warn_text = [warn_text, text] endif else warn_text = [warn_text, text] text=strarr(1) text(0)=string(leftmost_wave,highest_nored_wave,$ '(f7.2, " to ",f7.2," Angstroms: < 10%, set to zero.")') warn_text = [warn_text, text, ' '] endif endelse endfor ; end loop over exposures endfor ; end loop over panels if (size(warn_text))(0) ne '' then begin POP_UP_SCROLL, 'Note', warn_text write_succeeded = 0 while write_succeeded eq 0 do begin tmp=DIR_EXIST('WARN/') if tmp eq 0 then spawn,'mkdir WARN/', /sh outfile = pickfile(file='WARN/'+ws.k.filename+'.warn', $ title='Select a file to save this warning') openw, unit2, outfile, ERROR=err, /get_lun if (err eq 0) then write_succeeded = 1 else begin text=strarr(1) text(0)= 'There was an error writing to the selected file:' text = [text, !ERR_STRING] text = [text, 'Please choose again.'] POP_UP, 'Error',text endelse endwhile printf, unit2, warn_text free_lun, unit2 endif ; stat='sp_rad' ws.k.status=stat end ;------------------------------------------------------------------------- ; Process events for LYA 1st/2nd Order selection widget: DP 11/00 ;------------------------------------------------------------------------- pro CAL_RAD_LYA_EVENT,ev common uvcs_rad,button,trcal,contin,cancel,stat1,order,button_order ; text_2ndorder = 'Second order radiometric calibration not yet available' ; DP 05 if ev.id eq button_order then begin order = ev.value + 1 return endif if ev.id eq contin then begin stat1='OK' if order eq 2 then begin POP_UP, 'Second Order information', text_2ndorder return endif widget_control,ev.top,/destroy return endif ; if ev.id eq cancel then begin stat1='Cancel' widget_control,ev.top,/destroy return endif ; end ;------------------------------------------------------------------------- ; Process events for Primary/Redundant selection widget: ;------------------------------------------------------------------------- pro CAL_RAD_EVENT,ev common uvcs_rad,button,trcal,contin,cancel,stat1,order,button_order ; ; Added order-choosing button, DP 11/00 text_2ndorder = 'Second order radiometric calibration not yet available' ;DP 05 if ev.id eq button_order then begin order = ev.value + 1 return endif if ev.id eq contin then begin stat1='OK' if order eq 2 then begin POP_UP, 'Second Order information', text_2ndorder ;DP 11/00 return endif widget_control,ev.top,/destroy return endif ; if ev.id eq cancel then begin stat1='Cancel' widget_control,ev.top,/destroy return endif ; for n=0,n_elements(button)-1 do begin if ev.id eq button(n) then begin trcal(n)=ev.value return endif endfor end ;------------------------------------------------------------------------- ; Combine or delete exposures (summing counts or averaging intensities): ; ; Oct 04 update for DAS34 (VLC) - S. Giordano ;------------------------------------------------------------------------- pro SPA_EXP_COMB,ws,stat,path,file common uvcs_exp,wsx,uvalue,index,list,from,to,exp_tag,n_tag,mins,maxs,n_sum, $ combine,delete,label2,label4,grup,via,done,auto,nnum common exp_aut, re_call common wd_mn,wid_main ; gth if strmid(stat,0,3) ne 'sp_' and strmid(stat,0,3) ne 'vl_' then begin POP_UP,'Error',' Not an SPVL data set ' return endif if ws.k.expcount eq 1 then begin POP_UP,'Error','Data set has only one exposure' return endif if strmid(stat,0,3) eq 'vl_' then begin ;cb97 VLD_EXP_COMB,ws,stat,path,file ;cb97 return ;cb97 endif ;cb97 ; ; Create widget for combining or deleting exposures: ; via=0 grup=0 wsx=ws base=widget_base(title='Data Set nr. '+strcompress(ws.k.index)+ $ ' -- Combine/Delete',group_leader=wsx.k.wid_main, $ xoffset=200,yoffset=250,/column,/modal) ; pathfile=path+file len=STRLEN(pathfile) maxlen=46 if len gt maxlen then $ tmp=STRMID(pathfile,STRLEN(pathfile)-maxlen,maxlen) $ else tmp=pathfile label=widget_label(base,value=tmp,resource_name='white') ; label2=widget_label(base,value=' Number of Exposures: '+ $ strcompress(ws.k.expcount) +' ') names=strarr(wsx.k.expcount+1) names(0)=' I MIRPOS GRTPOS EXPTIME ' for k=0,wsx.k.expcount-1 do $ names(k+1)=string(k,wsx.f(k).mirpos,wsx.f(k).grtpos,wsx.f(k).exptime, $ '(i4,2x,i7,2x,i7,3x,f9.2)') index=-1 list =widget_list(base,value=names,uvalue='List',ysize=20, $ resource_name='white') base0=widget_base(base,/row) from=cw_field(base0,title='From:',value=0,/row,/integer,/noedit,xsize=4) to =cw_field(base0,title='To:',value=0,/row,/integer,/noedit,xsize=4) nnum=cw_field(base0,title=' Selected:',value=0,/row,xsize=4,/noedit) label3=widget_label(base,value=' Combining/Deleting Exposures list:') n_tag=0 mins=intarr(ws.k.expcount-1) & maxs=mins & n_sum=wsx.k.expcount exp_tag=widget_text(base,value='',resource_name='white') label4=cw_field(base,title=' Total Exposures selected: ',value=0,/row, $ xsize=7,/noedit) base1=widget_base(base,/row) combine=widget_button(base1,value='Combine',uvalue='Combine', $ resource_name='red') widget_control,combine,sensitive=0 delete =widget_button(base1,value='Delete' ,uvalue='Delete', $ resource_name='red') widget_control,delete,sensitive=0 done =widget_button(base1,value='Done' ,uvalue='Done', $ resource_name='green') widget_control,done,sensitive=0 cancel =widget_button(base1,value='Cancel' ,uvalue='Cancel', $ resource_name='green') auto =widget_button(base1,value='Combine MIRPOS',uvalue='Auto', $ resource_name='yellow') widget_control,base,/realize xmanager,'EXP_COMB',base if uvalue ne 'Cancel' then begin ws=0 ws=wsx endif wsx=0 end ; ; ;------------------------------------------------------------------------- ; Event handler for combining or deleting exposures: ; ; Oct 04 update for DAS34 (VLC) - S. Giordano ;------------------------------------------------------------------------- pro EXP_COMB_EVENT,ev common uvcs_exp,wsx,uvalue,index,list,from,to,exp_tag,n_tag,mins,maxs,n_sum, $ combine,delete,label2,label4,grup,via,done,auto,nnum common exp_aut, re_call ; widget_control,ev.id,get_uvalue=uvalue ; ; Done or Cancel: ; if uvalue eq 'Done' or uvalue eq 'Cancel' then begin re_call=0 widget_control,ev.top,/destroy return endif ; if via eq 1 then return ; if index eq -1 then begin widget_control,delete,sensitive=0 widget_control,combine,sensitive=0 endif else begin widget_control,delete,sensitive=1 widget_control,combine,sensitive=1 endelse ; ; Select index_from and index_to by clicking twice in list: ; if ev.id eq list then begin widget_control,auto,sensitive=0 if ev.index eq 0 then return if index lt 0 then begin index=ev.index-1 ; set index_from after first click index_from=index widget_control,from,set_value=index_from ; widget_control,to ,set_value=0 ; widget_control,nnum,set_value=0 endif else begin index_from=index index_to =ev.index-1 widget_control,to ,set_value=index_to ; widget_control,nnum,set_value=index_to-index_from+1 if index_to lt index_from then begin POP_UP,'Error','TO values not correct' re_call=1 widget_control,ev.top,/destroy return endif if n_tag ne 0 then begin if index_from le maxs(n_tag-1) or index_to le maxs(n_tag-1) then begin POP_UP,'Error','FROM or TO values not correct' re_call=1 widget_control,ev.top,/destroy return endif endif if index_from eq index_to then begin widget_control,exp_tag,set_value=' '+strcompress(index_from,/remove_all) $ +',',/append endif else begin widget_control,exp_tag,set_value=' '+strcompress(index_from,/remove_all) $ +'->'+strcompress(index_to,/remove_all)+',',/append endelse grup=temporary(grup)+1 mins(n_tag)=index_from & maxs(n_tag)=index_to n_tag=temporary(n_tag)+1 n_sum=temporary(n_sum)-(index_to-index_from+1) widget_control,label4,set_value=wsx.k.expcount-n_sum index=-1 endelse return endif ; ; Combine MIRPOS ; All the exposures will be combined by mirror position automatically ; if uvalue eq 'Auto' then begin dlt=10 & grup=0 num=wsx.k.expcount widget_control,ev.top,/hourglass siz=size(wsx.d) rif=wsx.f(0).mirpos & mins(0)=0 for i=1,num-1 do begin if wsx.f(i).mirpos gt rif-dlt and wsx.f(i).mirpos lt rif+dlt then begin ;do nothing endif else begin maxs(grup)=i-1 if mins(grup) eq maxs(grup) then begin grup=temporary(grup)-1 endif grup=temporary(grup)+1 mins(grup)=i rif=wsx.f(i).mirpos endelse if i eq num-1 then begin maxs(grup)=i if mins(grup) eq maxs(grup) then begin mins(grup)=0 & maxs(grup)=0 grup=temporary(grup)-1 endif endif endfor if grup eq -1 then begin for i=0,num-2 do begin if wsx.f(i).mirpos gt wsx.f(i+1).mirpos then grup=-2 endfor if grup eq -1 then begin POP_UP,'Error','No exposures at same MIRPOS are present!' widget_control,auto,sensitive=0 endif else begin POP_UP_SC,'Error',' Exposures must be ordered by MIRPOS ',ans if ans eq 'Cancel' then widget_control,auto,sensitive=0 if ans eq 'Order' then begin ; ; Order Exposures for increasing mirpos ; i=indgen(wsx.k.expcount) a=SORT(wsx.f.mirpos) wsx.f(i)=wsx.f(a) wsx.d(*,*,i)=wsx.d(*,*,a) q=SIZE(TAG_NAMES(wsx)) if q(1) ge 5 then wsx.b(*,i)=wsx.b(*,a) re_call=1 widget_control,ev.top,/destroy endif endelse grup=0 return endif for ii=grup,0,-1 do begin index_from=mins(ii) & index_to=maxs(ii) number=index_to-index_from+1 EXP_COMB_CONF,wsx.f(index_from:index_to),conf,wsx.k.ext if index_from gt 0 then conf=[wsx.f(0:index_from-1),conf] if index_to lt num-1 then conf=[conf,wsx.f(index_to+1:num-1)] wsx.f=conf ; & conf={CONF} new=num-number+1 if wsx.k.ext eq 'DET_UV' then begin data=fltarr(siz(1),siz(2),new) for i=index_from,index_to do data(*,*,index_from)= $ data(*,*,index_from)+wsx.d(*,*,i) if wsx.k.status eq 'sp_rad' then data(*,*,index_from)= $ data(*,*,index_from)/number if index_from gt 0 then $ data(*,*,0:index_from-1)=wsx.d(*,*,0:index_from-1) if index_to lt num-1 then $ data(*,*,index_from+1:new-1)=wsx.d(*,*,index_to+1:num-1) wsx.d=0 wsx.d=data num=num-number+1 endif else data=0 endfor lab4=0 for i=0,grup do begin widget_control,exp_tag,set_value=' '+strcompress(mins(i),/remove_all) $ +'->'+strcompress(maxs(i),/remove_all)+',',/append lab4=lab4+(maxs(i)-mins(i))+1 endfor widget_control,label4,set_value=lab4 wsx={k: wsx.k, f: conf, c: wsx.c, d: data, b:wsx.b} wsx.k.expcount=new widget_control,done,sensitive=1 endif ; ; Combine or Delete exposures: ; if uvalue eq 'Combine' or uvalue eq 'Delete' then begin num=wsx.k.expcount widget_control,from,get_value=index_from if index_from lt 0 or index_from gt num-1 then begin POP_UP,'Error','FROM value out of range' re_call=1 widget_control,ev.top,/destroy return endif widget_control,to,get_value=index_to if index_to lt 0 or index_to gt num-1 then begin POP_UP,'Error','TO value out of range' re_call=1 widget_control,ev.top,/destroy return endif if index_from gt index_to then begin POP_UP,'Error','FROM value must be less than or equal TO value' re_call=1 widget_control,ev.top,/destroy return endif number=index_to-index_from+1 if uvalue eq 'Delete' and number eq num then begin POP_UP,'Error','Cannot delete all exposures' re_call=1 widget_control,ev.top,/destroy return endif widget_control,ev.top,/hourglass siz=size(wsx.d) if uvalue eq 'Combine' then begin ;Combine for ii=0,grup-1 do begin if mins(ii) eq maxs(ii) then begin POP_UP,'Error','Cannot combine one exposure with itself' re_call=1 widget_control,ev.top,/destroy return endif endfor for ii=grup-1,0,-1 do begin index_from=mins(ii) & index_to=maxs(ii) number=index_to-index_from+1 EXP_COMB_CONF,wsx.f(index_from:index_to),conf,wsx.k.ext if index_from gt 0 then conf=[wsx.f(0:index_from-1),conf] if index_to lt num-1 then conf=[conf,wsx.f(index_to+1:num-1)] wsx.f=conf ; & conf={CONF} new=num-number+1 if wsx.k.ext eq 'DET_UV' then begin data=fltarr(siz(1),siz(2),new) for i=index_from,index_to do data(*,*,index_from)= $ data(*,*,index_from)+wsx.d(*,*,i) if wsx.k.status eq 'sp_rad' then data(*,*,index_from)= $ data(*,*,index_from)/number if index_from gt 0 then $ data(*,*,0:index_from-1)=wsx.d(*,*,0:index_from-1) if index_to lt num-1 then $ data(*,*,index_from+1:new-1)=wsx.d(*,*,index_to+1:num-1) wsx.d=0 wsx.d=data num=num-number+1 endif else data=0 endfor endif else begin ;Delete p=0 & sum=0 & f=0 & ns=40 ;Temporary conf=replicate({CONF},n_sum) data=fltarr(siz(1),siz(2),n_sum) if wsx.k.ext eq 'DET_UV' then begin ;sum=0 ---> copy data in data(*,*,f) and other keywords(f) ;sum=1 ---> deleting for i=0,wsx.k.expcount-1 do begin if i eq mins(p) then sum=1 if sum eq 1 then goto,dopo data(*,*,f)=wsx.d(*,*,i) ;copy all fields of the structure CONF ;for ii=0,56 do conf(f).(ii)=wsx.f(i).(ii) ;cb97 for ii=0,57 do conf(f).(ii)=wsx.f(i).(ii) ;cb97 f=temporary(f)+1 dopo: if i eq maxs(p) then begin sum=0 if p lt ns-1 then p=p+1 endif endfor new=n_sum endif else begin ;cb97 new=n_sum ;cb97 data=0 ;cb97 endelse ;cb97 endelse wsx={k: wsx.k, f: conf, c: wsx.c, d: data, b: wsx.b} wsx.k.expcount=new widget_control,done,sensitive=1 endif ; ; Redisplay list: ; widget_control,label2,set_value=' Number of Exposures: '+ $ strcompress(wsx.k.expcount)+' ' names=strarr(wsx.k.expcount+1) names(0)=' I MIRPOS GRTPOS EXPTIME ' for k=0,wsx.k.expcount-1 do $ names(k+1)=string(k,wsx.f(k).mirpos,wsx.f(k).grtpos,wsx.f(k).exptime, $ '(i3,2x,i7,2x,i7,3x,f9.2)') widget_control,list,set_value=names widget_control,exp_tag,get_value=list ; & help,list(0) if uvalue eq 'Delete' then list='Deleted:'+list if uvalue eq 'Combine' then list='Combined:'+list if uvalue eq 'Auto' then list='Combined by MIRPOS:'+list via=1 list=strmid(list(0),0,strlen(list(0))-1) ; & help,list widget_control,exp_tag,set_value=list re_call=0 end ;------------------------------------------------------------------------- ; Combine configuration data from several exposures: ; ; Oct 04 update for DAS34 (VLC) - S. Giordano ;------------------------------------------------------------------------- pro EXP_COMB_CONF,cf,conf,ext ; m=n_elements(cf)-1 conf={CONF} conf.dat_xobs=cf(0).dat_xobs conf.dat_xend=cf(m).dat_xend conf.oblk =cf(0).oblk conf.buffer =cf(0).buffer conf.roll =avg(cf.roll) conf.ptgx1 =avg(cf.ptgx1) conf.ptgx2 =avg(cf.ptgx2) conf.sunvt =avg(cf.sunvt) conf.sunvb =avg(cf.sunvb) conf.sunvr =avg(cf.sunvr) conf.sunvl =avg(cf.sunvl) conf.mirpos =avg(cf.mirpos) conf.occpos =avg(cf.occpos) conf.fltpos =cf(0).fltpos ;** conf.sc_y =avg(cf.sc_y) conf.sc_z =avg(cf.sc_z) conf.sc_roll =avg(cf.sc_roll) conf.rolangl =avg(cf.rolangl) conf.posx1 =avg(cf.posx1) conf.posx2 =avg(cf.posx2) conf.mirangl =avg(cf.mirangl) conf.cmdmir =avg(cf.cmdmir) conf.occwdth =avg(cf.occwdth) conf.ins_roll=avg(cf.ins_roll) conf.ins_y0 =avg(cf.ins_y0) conf.ins_z0 =avg(cf.ins_z0) conf.sc_yr =avg(cf.sc_yr) conf.sc_zr =avg(cf.sc_zr) conf.ins_yr =avg(cf.ins_yr) conf.sun_yr =avg(cf.sun_yr) conf.sun_zr =avg(cf.sun_zr) if ext eq 'DET_UV' then begin conf.tai_xobs=cf(0).tai_xobs conf.exptime =total(cf.exptime) conf.sltpos =avg(cf.sltpos) conf.grtpos =avg(cf.grtpos) conf.mcpv =avg(cf.mcpv) conf.sltwdth =avg(cf.sltwdth) conf.mcpvolt =avg(cf.mcpvolt) conf.wrval(0)=avg(cf.wrval(0)) conf.wrval(1)=avg(cf.wrval(1)) conf.wdelt(0)=avg(cf.wdelt(0)) conf.wdelt(1)=avg(cf.wdelt(1)) endif else begin conf.vlhv =avg(cf.vlhv) conf.vlhvolt =avg(cf.vlhvolt) conf.stokes_i(0)=avg(cf.stokes_i(0));MR6/99 conf.stokes_q(0)=avg(cf.stokes_q(0));MR6/99 conf.stokes_u(0)=avg(cf.stokes_u(0));MR6/99 conf.stokes_i(1)=avg(cf.stokes_i(1));MR6/99 conf.stokes_q(1)=avg(cf.stokes_q(1));MR6/99 conf.stokes_u(1)=avg(cf.stokes_u(1));MR6/99 conf.pb=avg(cf.pb) ;cb97 conf.pberr=avg(cf.pberr) ;cb97 conf.pbang=avg(cf.pbang) ;cb97 conf.pbangerr=avg(cf.pbangerr) ;cb97 num =cf(0).vlenum vlstrt =cf(0).vlstrt(0:num-1) vlexp =cf(0).vlexp(0:num-1) vlcnt =cf(0).vlcnt(0:num-1) vlmode =cf(0).vlmode(0:num-1) vlrad1 =cf(0).vlrad1(0:num-1) vlrad2 =cf(0).vlrad2(0:num-1) polpos =cf(0).polpos(0:num-1) polangl=cf(0).polangl(0:num-1) if m gt 0 then begin for n=1,m do begin num =cf(n).vlenum vlstrt =[vlstrt ,cf(n).vlstrt(0:num-1)] vlexp =[vlexp ,cf(n).vlexp(0:num-1)] vlcnt =[vlcnt ,cf(n).vlcnt(0:num-1)] vlmode =[vlmode ,cf(n).vlmode(0:num-1)] vlrad1 =[vlrad1 ,cf(n).vlrad1(0:num-1)] vlrad2 =[vlrad2 ,cf(n).vlrad2(0:num-1)] polpos =[polpos ,cf(n).polpos(0:num-1)] ;avg? ;cb97 polangl=[polangl,cf(n).polangl(0:num-1)] endfor endif index=sort(polpos) unique=polpos(uniq(polpos,index)) conf.vlenum=n_elements(unique) for n=0,conf.vlenum-1 do begin index=where(polpos eq unique(n)) conf.vlstrt(n) =min(vlstrt(index)) conf.vlexp(n) =total(vlexp(index)) conf.vlcnt(n) =total(vlcnt(index)) conf.vlmode(n) =min(vlmode(index)) conf.vlrad1(n) =avg(vlrad1(index)) conf.vlrad2(n) =avg(vlrad2(index)) conf.polpos(n) =unique(n) conf.polangl(n)=avg(polangl(index)) endfor endelse end ;------------------------------------------------------------------------- ; Create widget for modifying or deleting panels: ; ; Jul 22 04 minor widget adjustments ;------------------------------------------------------------------------- pro SPA_PAN_MOD,ws,stat,path,file common pan,wsx,stat1,row_txt,row_mod,row_fr,row_to,row_bin,row_format, $ panel,col_txt,col_mod,col_fr,col_to,col_bin,col_format, $ delete,cancel,done,row_tot_bin,zoom_wd common wd_mn,wid_main ; if strmid(stat,0,3) ne 'sp_' then begin POP_UP,'Error',' Not an SP data set ' ;cb97 return endif ; zoom_wd=0 wsx=ws base=widget_base(title='Modify/Delete Panels', $ group_leader=wsx.k.wid_main, $ xoffset=440,yoffset=300,/column, /modal) pathfile=path+file len=STRLEN(pathfile) maxlen=46 if len gt maxlen then $ tmp=STRMID(pathfile,STRLEN(pathfile)-maxlen,maxlen) $ else tmp=pathfile txt =widget_label(base,value='File: '+tmp,resource_name='white') ; ; Widgets for modifying rows or positions along entrance slit: ; base1=widget_base(base,/column,/frame) txt=widget_label(base1,value='Row/Spatial Parameters:') txt=widget_label(base1,value='TDESC TDIM TRVAL TDELT TSIZE', $ /align_left) if stat eq 'sp_wav' or stat eq 'sp_wav_bck' or $ stat eq 'sp_rad' then begin row_format='(" ",a,3x,i4,2x,f7.1,2(2x,f7.3))' endif else begin row_format='(" ",a,3x,i4,3(3x,f6.1))' endelse text=string(wsx.k.tdesc(0,0),wsx.k.tdim(0,0), $ wsx.k.trval(0,0),wsx.k.tdelt(0,0), $ wsx.k.tsize(0,0),format=row_format) row_txt=widget_list(base1,value=text,xsize=45,ysize=1, $ resource_name='white') rowpos_min=wsx.k.trval(0,0) rowpos_max=rowpos_min+(wsx.k.tdim(0,0)-1)*wsx.k.tdelt(0,0) arow =widget_base(base1,/row) row_mod=widget_button(arow,value='MOD',resource_name='red') row_fr =cw_field(arow,title='from:',value=rowpos_min, $ xsize=6,/row,/floating) row_to =cw_field(arow,title='to:' ,value=rowpos_max, $ xsize=6,/row,/floating) ; arow=widget_base(base1,/row) null=widget_label(arow,value=' ') row_bin=cw_field(arow,title='rebin:' ,value=1, $ ;cb99 xsize=3,/row,/integer) row_tot_bin=cw_field(arow,title='total bin(s):' ,value=wsx.k.tdim(0,0),$ xsize=3,/row,/integer) ;cb99 ; ; Widgets for modifying columns or wavelengths: ; base2=widget_base(base,/column,/frame) txt=widget_label(base2,value='Column/Spectral Parameters:') txt=widget_label(base2,value=' N TDESC TDIM TRVAL TDELT TSIZE', $ /align_left) col_format='(i2,2x,a,6x,i4,3(3x,f6.1))' names=strarr(wsx.k.ndata) for n=0,wsx.k.ndata-1 do names(n)=string(n,wsx.k.tdesc(1,n),wsx.k.tdim(1,n), $ wsx.k.trval(1,n),wsx.k.tdelt(1,n), $ wsx.k.tsize(1,n),format=col_format) col_txt=widget_list(base2,value=names,xsize=45,ysize=12, $ resource_name='white') panel=0 colwav_min=wsx.k.trval(1,panel) colwav_max=colwav_min+(wsx.k.tdim(1,panel)-1)*wsx.k.tdelt(1,panel) brow =widget_base(base2,/row) col_mod=widget_button(brow,value='EXT',resource_name='red') col_fr =cw_field(brow,title='from:',value=colwav_min, $ xsize=6,/row,/floating) col_to =cw_field(brow,title='to:' ,value=colwav_max, $ xsize=6,/row,/floating) col_bin=cw_field(brow,title='rebin:' ,value=1, $ ;cb99 xsize=3,/row,/integer) ; brow =widget_base(base2,/row) delete =widget_button(brow,value='Delete Panel',resource_name='red') ; ; Buttons: ; crow =widget_base(base,/row) done =widget_button(crow,value=' Done ',resource_name='green') cancel =widget_button(crow,value='Cancel',resource_name='green') ; ; Realize widget and process events: ; widget_control,base,/realize widget_control,col_txt,set_list_select=panel xmanager,'PAN_MOD',base if stat1 ne 'Cancel' then begin ws=wsx endif end ;------------------------------------------------------------------------- ; Event handler for modifying or deleting panels: ; Jan 18 2002 New field in ws structure: ws.rf ;------------------------------------------------------------------------- pro PAN_MOD_EVENT,ev common pan,wsx,stat1,row_txt,row_mod,row_fr,row_to,row_bin,row_format, $ panel,col_txt,col_mod,col_fr,col_to,col_bin,col_format, $ delete,cancel,done,row_tot_bin,zoom_wd ; ; Done: ; if ev.id eq done then begin if zoom_wd ne 0 then widget_control,zoom_wd,/destroy widget_control,ev.top,/destroy stat1='OK' zoom_wd=0 return endif ; ; Cancel: ; if ev.id eq cancel then begin if zoom_wd ne 0 then widget_control,zoom_wd,/destroy widget_control,ev.top,/destroy stat1='Cancel' zoom_wd=0 return endif ; ; Modify rows or positions along the slit (for all panels): ; if ev.id eq row_mod then begin num=wsx.k.ndata delta=wsx.k.tdelt(0,0) tsize=wsx.k.tsize(0,0) nrow =wsx.k.tdim(0,0) ; widget_control,row_bin,get_value=bin widget_control,row_tot_bin,get_value=tot_bin ; new_bin= nrow/float(tot_bin) ; if bin lt 1 or bin gt nrow then begin POP_UP,'Error','Rebin factor out of range [1,TDIM]' return endif ; if tot_bin lt 1 or tot_bin gt nrow then begin POP_UP,'Error','Total bin(s) out of range [1,TDIM]' ;cb99 return endif ; if tot_bin ne nrow then begin if bin ne 1 then begin POP_UP,'Error','Please do not use "rebin" and "total bin(s)" options at the SAME TIME!!!!!' ;cb99 return endif endif ; rowpos_min=wsx.k.trval(0,0) ; rowpos_max=rowpos_min+(nrow-1)*delta widget_control,row_fr,get_value=rowpos_from ifr=nint((rowpos_from-rowpos_min)/delta) rowpos_from=rowpos_min+delta*ifr widget_control,row_fr,set_value=rowpos_from if ifr lt 0 or ifr gt nrow-1 then begin POP_UP,'Error','FROM value out of range' return endif widget_control,row_to,get_value=rowpos_to ito=nint((rowpos_to-rowpos_min)/delta) rowpos_to=rowpos_min+delta*ito widget_control,row_to,set_value=rowpos_to if ito lt 0 or ito gt nrow-1 then begin POP_UP,'Error','TO value out of range' return endif if ito lt ifr+bin-1 then begin POP_UP,'Error','TO must be larger than or equal FROM+TDELT*(BIN-1)' return endif number=(ito-ifr+1)/bin widget_control,ev.top,/hourglass ncoltot=wsx.k.en(num) data=fltarr( number,ncoltot,wsx.k.expcount) data=reform(data,number,ncoltot,wsx.k.expcount) ; if tot_bin ne nrow then begin b=float(tot_bin) c=nrow*b data=fltarr( b,ncoltot,wsx.k.expcount) data=reform(data,b,ncoltot,wsx.k.expcount) c_fact=replicate(b,n_elements(wsx.d(*,0,0))) ; for e=0,wsx.k.expcount-1 do begin datac=wsx.d(*,*,e) datac=C_R_REPL(datac,c_fact,0) for f=0,ncoltot-1 do begin for g=0,b-1 do data(g,f,e)=total(datac(nrow*g:nrow*(g+1)-1,f))/b endfor endfor ; endif else begin for n=0,number-1 do begin for ib=0,bin-1 do data(n,*,*)=data(n,*,*)+wsx.d(ifr+n*bin+ib,*,*) endfor endelse ; if MAX(wsx.b) ne 0. then begin bck=fltarr( number,wsx.k.expcount) bck=reform(bck,number,wsx.k.expcount) for n=0,number-1 do begin for ib=0,bin-1 do bck(n,*)=bck(n,*)+wsx.b(ifr+n*bin+ib,*) endfor endif else begin bck=0. endelse ; if tot_bin ne nrow then bin=new_bin if tot_bin ne nrow then number=b ; if wsx.k.status eq 'sp_rad' then data=data/bin ; wsx={k: wsx.k, f: wsx.f, c: wsx.c, d: data, b: bck} ; for n=0,num-1 do begin wsx.k.trval(0,n)=rowpos_from+0.5*delta*(bin-1) wsx.k.tdelt(0,n)=bin*delta wsx.k.tsize(0,n)=tsize+(bin-1)*delta wsx.k.tdim(0,n)=number endfor ; text=string(wsx.k.tdesc(0,0),wsx.k.tdim(0,0), $ wsx.k.trval(0,0),wsx.k.tdelt(0,0), $ wsx.k.tsize(0,0),format=row_format) widget_control,row_txt,set_value=text rowpos_min=wsx.k.trval(0,0) rowpos_max=rowpos_min+(wsx.k.tdim(0,0)-1)*wsx.k.tdelt(0,0) widget_control,row_fr ,set_value=rowpos_min widget_control,row_to ,set_value=rowpos_max widget_control,row_bin,set_value=1 return endif ; ; Select panel: ; if ev.id eq col_txt then begin ; if N_ELEMENTS(zoom_wd) ne 0 then begin if zoom_wd ne 0 then widget_control,zoom_wd,/destroy zoom_wd=0 endif ; panel=ev.index colwav_min=wsx.k.trval(1,panel) colwav_max=colwav_min+(wsx.k.tdim(1,panel)-1)*wsx.k.tdelt(1,panel) widget_control,col_fr,set_value=colwav_min widget_control,col_to,set_value=colwav_max UVCS_DTW wsx.k.npan=panel DISP_ZOOM,wsx,zoom_wd return endif ; ; Delete panel: ; if ev.id eq delete then begin num=wsx.k.ndata if num le 1 then begin POP_UP,'Error','Data set has only one panel' return endif else begin widget_control,ev.top,/hourglass ncoltot=wsx.k.en(num)-wsx.k.tdim(1,panel) data=fltarr( wsx.k.tdim(0,0),ncoltot,wsx.k.expcount) data=reform(data,wsx.k.tdim(0,0),ncoltot,wsx.k.expcount) if panel gt 0 then begin data(*,0:wsx.k.en(panel)-1,*)=wsx.d(*,0:wsx.k.en(panel)-1,*) endif if panel lt num-1 then begin data(*,wsx.k.en(panel):ncoltot-1,*)= $ wsx.d(*,wsx.k.en(panel+1):wsx.k.en(num)-1,*) for n=panel,num-2 do begin wsx.k.tdesc(1,n)=wsx.k.tdesc(1,n+1) wsx.k.tdim (1,n)=wsx.k.tdim (1,n+1) wsx.k.trval(1,n)=wsx.k.trval(1,n+1) wsx.k.tdelt(1,n)=wsx.k.tdelt(1,n+1) wsx.k.tsize(1,n)=wsx.k.tsize(1,n+1) wsx.k.trcal( n)=wsx.k.trcal( n+1) endfor endif wsx.k.tdesc(0,num-1)='' & wsx.k.tdesc(1,num-1)='' wsx.k.tdim (0,num-1)=0 & wsx.k.tdim (1,num-1)=0 wsx.k.trval(0,num-1)=0 & wsx.k.trval(1,num-1)=0 wsx.k.tdelt(0,num-1)=0 & wsx.k.tdelt(1,num-1)=0 wsx.k.tsize(0,num-1)=0 & wsx.k.tsize(1,num-1)=0 wsx.k.trcal( num-1)=0 if panel gt 0 then panel=panel-1 wsx.k.ndata=num-1 wsx.k.en=0 for n=0,wsx.k.ndata-1 do wsx.k.en(n+1)=wsx.k.en(n)+wsx.k.tdim(1,n) colwav_min=wsx.k.trval(1,panel) colwav_max=colwav_min+(wsx.k.tdim(1,panel)-1)*wsx.k.tdelt(1,panel) widget_control,col_fr,set_value=colwav_min widget_control,col_to,set_value=colwav_max wsx={k: wsx.k, f: wsx.f, c: wsx.c, d: data, b: wsx.b} endelse endif ; ; Create a new panel by copying data from the selected panel: ; if ev.id eq col_mod then begin num=wsx.k.ndata if num ge 15 then begin POP_UP,'Error','Cannot handle more than 15 panels' return endif else begin delta=wsx.k.tdelt(1,panel) tsize=wsx.k.tsize(1,panel) ncol =wsx.k.tdim(1,panel) nsum =wsx.k.en(panel+1) widget_control,col_bin,get_value=bin if bin lt 1 or bin gt ncol then begin POP_UP,'Error','Binning factor out of range [1,TDIM]' return endif colwav_min=wsx.k.trval(1,panel) colwav_max=colwav_min+(ncol-1)*delta widget_control,col_fr,get_value=colwav_from ifr=nint((colwav_from-colwav_min)/delta) colwav_from=colwav_min+delta*ifr widget_control,col_fr,set_value=colwav_from if ifr lt 0 or ifr gt ncol-1 then begin POP_UP,'Error','FROM value out of range' return endif widget_control,col_to,get_value=colwav_to ito=nint((colwav_to-colwav_min)/delta) colwav_to=colwav_min+delta*ito widget_control,col_to,set_value=colwav_to if ito lt 0 or ito gt ncol-1 then begin POP_UP,'Error','TO value out of range' return endif if ito lt ifr+bin-1 then begin POP_UP,'Error','TO must be larger than or equal FROM+TDELT*(BIN-1)' return endif number=(ito-ifr+1)/bin widget_control,ev.top,/hourglass ncoltot=wsx.k.en(num)+number data=fltarr( wsx.k.tdim(0,0),ncoltot,wsx.k.expcount) data=reform(data,wsx.k.tdim(0,0),ncoltot,wsx.k.expcount) data(*,0:nsum-1,*)=wsx.d(*,0:nsum-1,*) if panel lt num-1 then begin data(*,nsum+number:ncoltot-1,*)=wsx.d(*,nsum:wsx.k.en(num)-1,*) for n=num,panel+2,-1 do begin wsx.k.tdesc(1,n)=wsx.k.tdesc(1,n-1) wsx.k.tdim (1,n)=wsx.k.tdim (1,n-1) wsx.k.trval(1,n)=wsx.k.trval(1,n-1) wsx.k.tdelt(1,n)=wsx.k.tdelt(1,n-1) wsx.k.tsize(1,n)=wsx.k.tsize(1,n-1) wsx.k.trcal( n)=wsx.k.trcal( n-1) endfor endif for n=0,number-1 do begin for ib=0,bin-1 do data(*,nsum+n,*)=data(*,nsum+n,*)+ $ wsx.d(*,wsx.k.en(panel)+ifr+n*bin+ib,*) endfor if wsx.k.status eq 'sp_rad' then $ data(*,nsum:nsum+number-1,*)=data(*,nsum:nsum+number-1,*)/bin wsx={k: wsx.k, f: wsx.f, c: wsx.c, d: data, b: wsx.b} wsx.k.tdesc(1,panel+1)=wsx.k.tdesc(1,panel) wsx.k.tdim (1,panel+1)=number wsx.k.trval(1,panel+1)=colwav_from+0.5*delta*(bin-1) wsx.k.tdelt(1,panel+1)=bin*delta wsx.k.tsize(1,panel+1)=tsize+(bin-1)*delta wsx.k.trcal( panel+1)=wsx.k.trcal( panel) wsx.k.ndata=num+1 wsx.k.en=0 for n=0,num do wsx.k.en(n+1)=wsx.k.en(n)+wsx.k.tdim(1,n) colwav_min=wsx.k.trval(1,panel) colwav_max=colwav_min+(wsx.k.tdim(1,panel)-1)*wsx.k.tdelt(1,panel) widget_control,col_fr ,set_value=colwav_min widget_control,col_to ,set_value=colwav_max widget_control,col_bin,set_value=1 endelse endif ; ; Redisplay list: ; names=strarr(wsx.k.ndata) for n=0,wsx.k.ndata-1 do names(n)=string(n,wsx.k.tdesc(1,n),wsx.k.tdim(1,n), $ wsx.k.trval(1,n),wsx.k.tdelt(1,n), $ wsx.k.tdelt(1,n),format=col_format) widget_control,col_txt,set_value=names,set_list_select=panel end ;------------------------------------------------------------------------- ; Concatenate two data sets: ;------------------------------------------------------------------------- pro SP2_CONC,ws,stat,path,file,wsb,stat_b,path_b,file_b ; ; Verify status: ; stat1=strmid(stat,0,3) if stat1 ne 'sp_' and stat1 ne 'vl_' then begin POP_UP,'Error','Data set A must contain SPVL data' return endif stat2=strmid(stat_b,0,3) if stat2 ne 'sp_' and stat2 ne 'vl_' then begin POP_UP,'Error','Data set B must contain SPVL data' return endif if uvcs_date_conv(ws.k.date_obs,'R') gt uvcs_date_conv(wsb.k.date_obs,'R') then begin POP_UP,'Error','Data set A must be earlier than data set B (see DATE_OBS)' return endif if stat ne stat_b then begin POP_UP,'Error','Data sets must have the same calibration status' return endif if ws.k.cal_file ne wsb.k.cal_file then begin POP_UP,'Error','Data sets must have the same calibration parameter file' return endif if stat1 eq 'sp_' then begin if ws.k.detector ne wsb.k.detector then begin POP_UP,'Error','Data sets must belong to the same detector' return endif error=0 if ws.k.ndata ne wsb.k.ndata or $ ws.k.tdim(0,0) ne wsb.k.tdim(0,0) or $ ws.k.trval(0,0) ne wsb.k.trval(0,0) or $ ws.k.tsize(0,0) ne wsb.k.tsize(0,0) or $ ws.k.tdelt(0,0) ne wsb.k.tdelt(0,0) then error=1 for n=0,ws.k.ndata-1 do begin if ws.k.tdim(1,n) ne wsb.k.tdim(1,n) or $ ws.k.trval(1,n) ne wsb.k.trval(1,n) or $ ws.k.tsize(1,n) ne wsb.k.tsize(1,n) or $ ws.k.tdelt(1,n) ne wsb.k.tdelt(1,n) then error=1 endfor if error then begin POP_UP,'Error','Data sets must have the same detector mask' return endif endif ; ; Concatenate data sets: ; conf=[ws.f,wsb.f] if stat1 eq 'sp_' then begin m=ws.k.expcount+wsb.k.expcount data=fltarr(ws.k.tdim(0,0),ws.k.en(ws.k.ndata),m) data(*,*,0:ws.k.expcount-1)=ws.d data(*,*,ws.k.expcount:m-1)=wsb.d ;endif else data=0 endif else begin ;cb97 data=0 ;cb97 m=ws.k.expcount+wsb.k.expcount ;cb97 endelse ;cb97 file=file+'.cnc' ;cb97 ws.k.file =file ws.k.filename=file ws.k.date_end=wsb.k.date_end ws.k.expcount=m ws={k: ws.k, f: conf, c: ws.c, d: data, b: ws.b} end ;------------------------------------------------------------------------- ; Create window for IDL commands: ;------------------------------------------------------------------------- pro IDL_CMD,wid_main ; base =widget_base(title='IDL Command',group_leader=wid_main, $ xoffset=300,yoffset=250,/column, /modal) cmd =cw_field(base,title='Command:',uvalue='CMD', $ /string,/return_events,xsize=60) label=widget_label(base,value='Refer to IDL window for output') base1=widget_base(base,/row) done =widget_button(base1,value=' Done ',uvalue='DONE',resource_name='green') widget_control,base,/realize xmanager,'IDL_CMD',base end ;------------------------------------------------------------------------- ; Process IDL commands: ; ; Oct 04 update for DAS34 - S. Giordano ;------------------------------------------------------------------------- pro IDL_CMD_EVENT,ev common das,ws0,ws1,ws2,ws3,ws4,ws5,ws6,ws7,ws8,ws9, $ ws10,ws11,ws12,ws13,ws14,ws15,ws16,ws17 common cat,plist,slist,tmp,def common wd_mn,wid_main common block3,src common prnt,wid_prnt ; widget_control,ev.id,get_uvalue=uvalue if uvalue eq 'CMD' then begin widget_control,ev.id,get_value=command result=execute(command(0)) endif if uvalue eq 'DONE' then widget_control,ev.top,/destroy end ;------------------------------------------------------------------------- ; Create widget for Printer Setup: ;------------------------------------------------------------------------- pro IDL_PRNT,wid_main common prnt,wid_prnt ; base =widget_base(title='Printer Setup',group_leader=wid_main, $ xoffset=300,yoffset=250,/column, /modal) das_prnt=getenv('DAS_PRNT') wid_prnt=cw_field(base,title='Printer:',value=das_prnt,/string,xsize=20) base1 =widget_base(base,/row) done =widget_button(base1,value=' OK ',uvalue='OK',resource_name='red') cancel=widget_button(base1,value='Cancel',uvalue='Cancel', $ resource_name='green') widget_control,base,/realize xmanager,'IDL_PRNT',base end ;------------------------------------------------------------------------- ; Process Printer Setup events: ;------------------------------------------------------------------------- pro IDL_PRNT_EVENT,ev common prnt,wid_prnt ; widget_control,ev.id,get_uvalue=uvalue ; if uvalue eq 'OK' then begin widget_control,wid_prnt,get_value=das_prnt das_prnt=strcompress(das_prnt(0),/remove_all) if das_prnt eq '' then begin POP_UP,'Error','Invalid printer name' return endif setenv,'DAS_PRNT='+das_prnt endif widget_control,ev.top,/destroy end ;------------------------------------------------------------------------- ; Generate text for keyword listing: ;------------------------------------------------------------------------- pro FITS_SHOW_KEY,key,text ; ; Primary Header Keywords (indicated by *) and other parameters ; available in the KEY data structure: ; path =string(key.path ,format='(" PATH = ",a)') file =string(key.file ,format='(" FILE = ",a)') date =string(key.date ,format='("*DATE = ",a)') filename=string(key.filename,format='("*FILENAME = ",a)') tlm_file=string(key.tlm_file,format='("*TLM_FILE = ",a)') ext =string(key.ext ,format='("*EXT = ",a)') origin =string(key.origin ,format='("*ORIGIN = ",a)') telescop=string(key.telescop,format='("*TELESCOP = ",a)') instrume=string(key.instrume,format='("*INSTRUME = ",a)') detector=string(key.detector,format='("*DETECTOR = ",a)') excon =string(key.excon ,format='("*EXCON = ",a)') expcount=string(key.expcount,format='("*EXPCOUNT = ",i7)') tai_obs =string(key.tai_obs ,format='("*TAI_OBS = ",f14.3)') tai_end =string(key.tai_end ,format='("*TAI_END = ",f14.3)') date_obs=string(key.date_obs,format='("*DATE_OBS = ",a)') date_end=string(key.date_end,format='("*DATE_END = ",a)') status =string(key.status ,format='("*STATUS = ",a)') sc_stat =string(key.sc_stat ,format='("*SC_STAT = ",a)') flt_path=string(key.flt_path,format='(" FLT_PATH = ",a)') flt_file=string(key.flt_file,format='("*FLT_FILE = ",a)') drk_path=string(key.drk_path,format='(" DRK_PATH = ",a)') drk_file=string(key.drk_file,format='("*DRK_FILE = ",a)') cal_path=string(key.cal_path,format='(" CAL_PATH = ",a)') cal_file=string(key.cal_file,format='("*CAL_FILE = ",a)') orb_path=string(key.orb_path,format='(" ORB_PATH = ",a)') orb_file=string(key.orb_file,format='("*ORB_FILE = ",a)') att_path=string(key.att_path,format='(" ATT_PATH = ",a)') att_file=string(key.att_file,format='("*ATT_FILE = ",a)') obs_num =string(key.obs_num ,format='("*OBS_NUM = ",i7)') obs_type=string(key.obs_type,format='("*OBS_TYPE = ",a)') text=[path,file,date,filename,tlm_file,ext,origin,telescop,instrume, $ detector,excon,expcount,tai_obs,tai_end,date_obs,date_end, $ status,sc_stat,flt_path,flt_file,drk_path,drk_file,cal_path, $ cal_file,orb_path,orb_file,att_path,att_file,obs_num,obs_type] if key.detector ne 'VLD' then begin ;cb97 ; ; Original masking/binning parameters: (for UV only) ;cb97 ; npanel =string(key.npanel ,format='("*NPANEL = ",i7)') rowngrp =string(key.rowngrp ,format='("*ROWNGRP = ",i7)') rowfrst =string(key.rowfrst ,format='("*ROWFRST = ",i7)') rowact =string(key.rowact ,format='("*ROWACT = ",i7)') ;cb97 rowspc =string(key.rowspc ,format='("*ROWSPC = ",i7)') ;cb97 text=[text,npanel,rowngrp,rowfrst,rowact,rowspc] for n=0,key.npanel-1 do begin colngrp=string(n,key.colngrp(n),format='("*COLNGRP(",i2,")= ",i7)') colfrst=string(n,key.colfrst(n),format='("*COLFRST(",i2,")= ",i7)') colact =string(n,key.colact(n) ,format='("*COLACT(",i2,") = ",i7)') colspc =string(n,key.colspc(n) ,format='("*COLSPC(",i2,") = ",i7)') text=[text,colngrp,colfrst,colact,colspc] endfor uvofst =string(key.uvofst ,format='("*UVOFST = ",i7)') uvbcnt =string(key.uvbcnt ,format='("*UVBCNT = ",i7)') uvtabl =string(key.uvtabl ,format='("*UVTABL = ",i7)') text=[text,uvofst,uvbcnt,uvtabl] ; ; Data coordinate parameters: ; ins_zr =string(key.ins_zr ,format='("*INS_ZR = ",f7.1)') ndata =string(key.ndata ,format='("*NDATA = ",i7)') tdim =string(key.tdim(0,0) ,format='("*TDIM(0,0) = ",i7)') tdesc =string(key.tdesc(0,0),format='("*TDESC(0,0) = ",a )') trval =string(key.trval(0,0),format='("*TRVAL(0,0) = ",f7.1)') tdelt =string(key.tdelt(0,0),format='("*TDELT(0,0) = ",f7.3)') tsize =string(key.tsize(0,0),format='("*TSIZE(0,0) = ",f7.3)') text=[text,ins_zr,ndata,tdim,tdesc,trval,tdelt,tsize] for n=0,key.ndata-1 do begin tdim =string(n,key.tdim(1,n) ,format='("*TDIM(1,",i2,") = ",i7)') tdesc=string(n,key.tdesc(1,n),format='("*TDESC(1,",i2,")= ",a )') trval=string(n,key.trval(1,n),format='("*TRVAL(1,",i2,")= ",f7.1)') tdelt=string(n,key.tdelt(1,n),format='("*TDELT(1,",i2,")= ",f7.1)') tsize=string(n,key.tsize(1,n),format='("*TSIZE(1,",i2,")= ",f7.1)') trcal=string(n,key.trcal(n) ,format='("*TRCAL(",i2,") = ",i7)') text=[text,tdim,tdesc,trval,tdelt,tsize,trcal] endfor endif ;cb97 end ;------------------------------------------------------------------------- ; Generate text for extended keyword listing: DP 5/00 ; ; Oct 04 update for DAS34 - S. Giordano ;------------------------------------------------------------------------- pro FITS_SHOW_EXT,key,text ; ; Shows keywords added to the header for catalog purposes ; object =string(key.n_object,format='(" OBJECT = ",a)') results =string(key.n_results,format='(" RESULTS = ",a)') observer=string(key.n_observer,format='(" OBSERVER = ",a)') obs_mode=string(key.n_obs_mode,format='(" OBS_MODE = ",a)') sci_obj =string(key.n_sci_obj,format='(" SCI_OBJ = ",a)') cmp_no =string(key.n_cmp_no,format='(" CMP_NO = ",i7)') cen =string(key.n_cen ,format='(" CEN = ",a)') width =string(key.n_width, format='(" WIDTH = ",a)') slit_id =string(key.n_slit_id,format='(" SLIT_ID = ",i7)') res =string(key.n_res ,format='(" RES = ",a)') exptime =string(key.n_exptime,format='(" EXPTIME = ",i7)') nwaves =string(key.n_nwaves,format='(" NWAVES = ",i7)') text=[object,results,observer,obs_mode,sci_obj,cmp_no,cen,$ width,slit_id,res,exptime,nwaves] for j=0, key.n_nwaves-1 do begin text = [text, string(j+1, key.n_wavelist(j),$ format='(" WAVE", i1, " = ",a )')] endfor end ;------------------------------------------------------------------------- ; Generate text for configuration parameter listing: ; ; Oct 04 update for DAS34 - S. Giordano ;------------------------------------------------------------------------- pro FITS_SHOW_CONF,detector,ndata,conf,text ; dat_xobs=string(conf.dat_xobs,format='("DAT_XOBS = ",a," UT")') dat_xend=string(conf.dat_xend,format='("DAT_XEND = ",a," UT")') oblk =string(conf.oblk ,format='("OBLK = ",i7," ")') buffer =string(conf.buffer ,format='("BUFFER = ",i7)') fltpos =string(conf.fltpos ,format='("FLTPOS = ",i7," ")') roll =string(conf.roll ,format='("ROLL = ",i7)') ptgx1 =string(conf.ptgx1 ,format='("PTGX1 = ",i7," ")') ptgx2 =string(conf.ptgx2 ,format='("PTGX2 = ",i7)') sunvt =string(conf.sunvt ,format='("SUNVT = ",i7," ")') sunvb =string(conf.sunvb ,format='("SUNVB = ",i7)') sunvr =string(conf.sunvr ,format='("SUNVR = ",i7," ")') sunvl =string(conf.sunvl ,format='("SUNVL = ",i7)') mirpos =string(conf.mirpos ,format='("MIRPOS = ",i7," ")') occpos =string(conf.occpos ,format='("OCCPOS = ",i7)') sc_y =string(conf.sc_y ,format='("SC_Y = ",f7.1," ")') sc_z =string(conf.sc_z ,format='("SC_Z = ",f7.1," arcsec")') sc_roll =string(conf.sc_roll ,format='("SC_ROLL = ",f7.2," ")') rolangl =string(conf.rolangl ,format='("ROLANGL = ",f7.2," deg ")') posx1 =string(conf.posx1 ,format='("POSX1 = ",f7.3," ")') posx2 =string(conf.posx2 ,format='("POSX2 = ",f7.3," mm ")') mirangl =string(conf.mirangl ,format='("MIRANGL = ",f7.3," Rsun ")') cmdmir =string(conf.cmdmir ,format='("CMDMIR = ",f7.3," Rsun ")') occwdth =string(conf.occwdth ,format='("OCCWDTH = ",f7.3," mm ")') ins_roll=string(conf.ins_roll,format='("INS_ROLL = ",f7.2," deg ")') ins_yr =string(conf.ins_yr ,format='("INS_YR = ",f7.1," arcsec")') ins_y0 =string(conf.ins_y0 ,format='("INS_Y0 = ",f7.1," ")') ins_z0 =string(conf.ins_z0 ,format='("INS_Z0 = ",f7.1," arcsec")') sc_yr =string(conf.sc_yr ,format='("SC_YR = ",f7.1," ")') sc_zr =string(conf.sc_zr ,format='("SC_ZR = ",f7.1," arcsec")') sun_yr =string(conf.sun_yr ,format='("SUN_YR = ",f7.1," ")') sun_zr =string(conf.sun_zr ,format='("SUN_ZR = ",f7.1," arcsec")') text=[dat_xobs,dat_xend,oblk+buffer,fltpos+roll,ptgx1+ptgx2,sunvt+sunvb, $ sunvr+sunvl,mirpos+occpos,sc_y+sc_z,sc_roll+rolangl,posx1+posx2, $ mirangl+cmdmir,occwdth,ins_roll+ins_yr,ins_y0+ins_z0,sc_yr+sc_zr, $ sun_yr+sun_zr] ; ; Configuration data for LYA and OVI channels: ; if detector eq 'LYA' or detector eq 'OVI' then begin tai_xobs=string(conf.tai_xobs,format='("TAI_XOBS = ",f14.3," sec ")') grtpos =string(conf.grtpos ,format='("GRTPOS = ",i7 ," ")') exptime =string(conf.exptime ,format='("EXPTIME = ",f9.2," sec ")') sltpos =string(conf.sltpos ,format='("SLTPOS = ",i7 ," ")') sltwdth =string(conf.sltwdth ,format='("SLTWDTH = ",f7.3," mm ")') mcpv =string(conf.mcpv ,format='("MCPV = ",i7 ," ")') mcpvolt =string(conf.mcpvolt ,format='("MCPVOLT = ",f7.0," V ")') wrval0 =string(conf.wrval(0),format='("WRVAL(0) = ",f8.2," ")') wrval1 =string(conf.wrval(1),format='("WRVAL(1) = ",f8.2," Angstrom")') wdelt0 =string(conf.wdelt(0),format='("WDELT(0) = ",f8.5," ")') wdelt1 =string(conf.wdelt(1),format='("WDELT(1) = ",f8.5," Angstrom")') text=[text,tai_xobs,grtpos+exptime,sltpos+sltwdth, $ mcpv+mcpvolt,wrval0+wrval1,wdelt0+wdelt1] endif ; ; Configuration data for VLD channel: ; if detector eq 'VLD' then begin vlhv =string(conf.vlhv ,format='("VLHV = ",i7 ," ")') vlhvolt=string(conf.vlhvolt,format='("VLHVOLT = ",f7.0," V ")') pb=string(conf.pb,format='("pB = ",E10.3," ")') ;cb97 pberr=string(conf.pberr,format='("pB_ERR = ",E10.3)') ;cb97 pbang=string(conf.pbang,format='("ANGLE = ",f8.3," ")') ;cb97 pbangerr=string(conf.pbangerr,format='("ANGLE_ERR = ",f8.3)') ;cb97 stokes_i=string(conf.stokes_i(0),format='("STOKES_I = ",E10.3," ")') ;cb97 ;MR6/99 stokes_q=string(conf.stokes_q(0),format='("STOKES_Q = ",E10.3," ")') ;cb97 ;MR6/99 stokes_u=string(conf.stokes_u(0),format='("STOKES_U = ",E10.3," ")') ;cb97 ;MR6/99 stokes_i_err=string(conf.stokes_i(1),format='("ST_I_ERR = ",E8.1)') ;cb97 ;MR6/99 stokes_q_err=string(conf.stokes_q(1),format='("ST_Q_ERR = ",E8.1)') ;cb97 ;MR6/99 stokes_u_err=string(conf.stokes_u(1),format='("ST_U_ERR = ",E8.1)') ;cb97 ;MR6/99 vlenum =string(conf.vlenum ,format='("VLENUM = ",i7)') ;cb97 text=[text,vlhv+vlhvolt,pb+pberr,pbang+pbangerr,stokes_i+stokes_i_err, $;cb97 ;MR6/99 stokes_q+stokes_q_err,stokes_u+stokes_u_err,vlenum] ;cb97 ;MR6/99 for i=0,conf.vlenum-1 do begin vlstrt =string(i,conf.vlstrt(i) ,format='("VLSTRT(",i1,") = ",f14.3)') vlexp =string(i,conf.vlexp(i) ,format='("VLEXP(",i1,") = ",f7.2)') vlcnt =string(i,conf.vlcnt(i) ,format='("VLCNT(",i1,") = ",i12)') ;cb97 vlmode =string(i,conf.vlmode(i) ,format='("VLMODE(",i1,") = ",i7)') vlrad1 =string(i,conf.vlrad1(i) ,format='("VLRAD1(",i1,") = ",i7)') vlrad2 =string(i,conf.vlrad2(i) ,format='("VLRAD2(",i1,") = ",i7)') polpos =string(i,conf.polpos(i) ,format='("POLPOS(",i1,") = ",i7)') polangl=string(i,conf.polangl(i),format='("POLANGL(",i1,")= ",f7.1)') text=[text,vlcnt,vlexp,polpos,polangl,vlmode,vlrad1,vlrad2,vlstrt] ;cb97 endfor endif end ;------------------------------------------------------------------------- ; Process events for keyword and configuration parameter display: ;------------------------------------------------------------------------- pro FITS_SHOW_EVENT,ev ; widget_control,ev.id,get_uvalue=uvalue ; ; Quit display: ; if uvalue eq 'QUIT' then begin widget_control,ev.top,/destroy return endif ; widget_control,ev.top,get_uvalue=wsa,/hourglass ; ; Select exposure ID (slider): ; if uvalue eq 'EXPO' then begin wsa.k.nexp=ev.value FITS_SHOW_CONF,wsa.k.detector,wsa.k.ndata,wsa.f(wsa.k.nexp),text widget_control,wsa.list,set_value=text endif ; ; Print keywords and configuration parameters: ; if uvalue eq 'PRINT' then begin openw,unit,'das.prnt',/get_lun FITS_SHOW_KEY ,wsa.k,text printf,unit,'Keywords:' for i=0,n_elements(text)-1 do printf,unit,' '+text(i) FITS_SHOW_CONF,wsa.k.detector,wsa.k.ndata,wsa.f(wsa.k.nexp),text printf,unit,'Configuration Parameters for exposure ID = ' $ +strcompress(wsa.k.nexp) for i=0,n_elements(text)-1 do printf,unit,' '+text(i) free_lun,unit das_prnt=getenv('DAS_PRNT') if das_prnt eq 'unknown' then POP_UP,'Error','Printer not selected' $ else spawn,'lpr -P'+das_prnt+' das.prnt', /sh ;DP 11/00 endif end ;------------------------------------------------------------------------- ; Show keywords and configuration parameters: ;------------------------------------------------------------------------- pro SPA_FITS_SHOW,ws,stat,path,file ; if strmid(stat,0,3) ne 'sp_' and strmid(stat,0,3) ne 'vl_' $ and strmid(stat,0,3) ne 'dar' and strmid(stat,0,3) ne 'fla' then begin POP_UP,'Error',' Not an SPVL data set ' return endif title='Data Set nr. '+strcompress(ws.k.index)+' -- File: '+path+file base=widget_base(title=title,group_leader=ws.k.wid_main, $ /row,xoffset=200,yoffset=250) ; ; Display keywords: ; col1 =widget_base(base,/column) label=widget_label(col1,value='Keywords') FITS_SHOW_KEY,ws.k,text list1=widget_list(col1,value=text,uvalue='LIST1',ysize=30, $ resource_name='white') ; ; Display configuration parameters for selected exposure: ; col2 =widget_base(base,/column) label=widget_label(col2,value='Configuration Parameters') FITS_SHOW_CONF,ws.k.detector,ws.k.ndata,ws.f(0),text list2=widget_list(col2,value=text,uvalue='LIST2',ysize=25, $ resource_name='white') if ws.k.expcount ne 1 then begin title='Exposure ID {0 to '+strcompress(ws.k.expcount-1,/remove_all)+'}' expo =widget_slider(col2,title=title,value=0,uvalue='EXPO', $ minimum=0,maximum=ws.k.expcount-1) endif else begin label=widget_label(col2,value='Only one exposure') endelse ws.k.nexp=0 arow=widget_base(col2,/row) prnt=widget_button(arow,value='Print',uvalue='PRINT',resource_name='red') done=widget_button(arow,value='Quit',uvalue='QUIT',resource_name='green') wsa={k: ws.k, f: ws.f, list: list2} widget_control,base,set_uvalue=wsa,/realize xmanager,'FITS_SHOW',base,/just_reg end ;------------------------------------------------------------------------- ; Process events for extended header display: DP 5/00 ;------------------------------------------------------------------------- pro FITS_EXT_EVENT,ev ; widget_control,ev.id,get_uvalue=uvalue ; ; Quit display: ; if uvalue eq 'QUIT' then begin widget_control,ev.top,/destroy return endif ; widget_control,ev.top,get_uvalue=wsa,/hourglass ; ; Print extended header keywords: ; if uvalue eq 'PRINT' then begin openw,unit,'das.prnt',/get_lun FITS_SHOW_EXT ,wsa.k,text printf,unit,'Extended Header Keywords:' for i=0,n_elements(text)-1 do printf,unit,' '+text(i) free_lun,unit das_prnt=getenv('DAS_PRNT') if das_prnt eq 'unknown' then POP_UP,'Error','Printer not selected' $ else spawn,'lpr -P'+das_prnt+' das.prnt', /sh; DP 11/00 endif end ;------------------------------------------------------------------------- ; Show extended keywords: DP 5/00 ;------------------------------------------------------------------------- pro SPA_FITS_EXT,ws,stat,path,file ; if strmid(stat,0,3) ne 'sp_' and strmid(stat,0,3) ne 'vl_' $ and strmid(stat,0,3) ne 'dar' and strmid(stat,0,3) ne 'fla' then begin POP_UP,'Error',' Not an SPVL data set ' return endif title='Data Set nr. '+strcompress(ws.k.index)+' -- File: '+path+file base=widget_base(title=title,group_leader=ws.k.wid_main, $ /row,xoffset=200,yoffset=250) ; ; Display keywords: ; col1 =widget_base(base,/column) label=widget_label(col1,value='Extended Header Keywords') FITS_SHOW_EXT,ws.k,text list1=widget_list(col1,value=text,uvalue='LIST1',ysize=30, $ resource_name='white') ws.k.nexp=0 arow=widget_base(col1,/row) prnt=widget_button(arow,value='Print',uvalue='PRINT',resource_name='red') done=widget_button(arow,value='Quit',uvalue='QUIT',resource_name='green') wsa={k: ws.k, f: ws.f} widget_control,base,set_uvalue=wsa,/realize xmanager,'FITS_EXT',base,/just_reg end ;------------------------------------------------------------------------- ; Copy from one data set into another: ;------------------------------------------------------------------------- pro SP2_COPY,ws,stat,path,file,wsb,stat_b,path_b,file_b if ws.k.status ne 'None' then begin title='Warning' text=' Do you want to overwrite the Data Set? ' POP_UP_OK,title,text,ans if ans eq 'Cancel' then return endif index=ws.k.index ws=0 ws=wsb ws.k.index=index stat=stat_b path=path_b file=file_b end ;------------------------------------------------------------------------- ; Perform Wavelength Calibration: ;------------------------------------------------------------------------- pro SPA_CAL_WAVE,ws,stat,path,file common wave,uvalue,wid,detect,num_wav,wav_min,wav_max, $ num_pos,pos_min,pos_max,pos_mn,pos_mx ;stfn=check_math(trap=0) ;rh97 (removed by Roger Hauck) ; ; Verify if you have the proper calibration : ; if strmid(stat,0,3) ne 'sp_' then begin POP_UP,'Error',' Not a Spectral data set ' return endif ; ; Verify calibration status: ; if stat ne 'sp_raw_conf' and stat ne 'sp_drk_conf' and $ stat ne 'sp_flt_conf' then begin POP_UP,'Error','Incorrect calibration status for wavelength calibration' return endif ;spawn,'ls -1 ../CAL',lst, /sh; added /sh DP 11/00 ;a=where(ws.k.cal_file eq lst,cnt) ;if cnt ne 1 then begin ; POP_UP,'Error','You Do Not Have the Proper Calibration File' ; return ;endif ; ; Set up arrays for full-scale image: ; ndata=ws.k.ndata imax =ws.k.tdim(0,0) drow=0.5*(ws.k.tsize(0,0)-1.0) dcol=0.5*(ws.k.tsize(1,*)-1.0) nr1=nint(ws.k.trval(0,0)+indgen(imax)*ws.k.tdelt(0,0)-drow) nr2=nint(ws.k.trval(0,0)+indgen(imax)*ws.k.tdelt(0,0)+drow) ; ; Find coefficients for distortion correction, row position associated ; with reference point on entrance slit, and spatial scale parameter: ; if ws.k.detector eq 'LYA' then begin detp=2 detr=2 endif else begin detp=3 detr=4 endelse ;poly_kx=ws.c.(detp).poly.kx ;IDL 4. ;poly_ky=ws.c.(detp).poly.ky ;IDL 4. poly_num=ws.c.(detp).poly.num ;Aug 13 1997, updating for IDL 5.0 poly_kx=ws.c.(detp).poly.kx(0:poly_num-1,0:poly_num-1) ;IDL 5.0 poly_ky=ws.c.(detp).poly.ky(0:poly_num-1,0:poly_num-1) ;IDL 5.0 ref_row=ws.c.(detp).ref.row ref_scl=ws.c.(detp).ref.scl ; ; Determine new masking/binning parameters, and set up array for ; calibrated data: ; rowfrst=intarr(ndata) rowlast=intarr(ndata) colfrst=intarr(ndata) coldelt=intarr(ndata) colact =intarr(ndata) colngrp=intarr(ndata) for n=0,ndata-1 do begin nc1=nint(ws.k.trval(1,n)-dcol(n)) nc2=nint(ws.k.trval(1,n)+(ws.k.tdim(1,n)-1)*ws.k.tdelt(1,n)+dcol(n)) cal_wave_solv,poly_kx,poly_ky,nc11,nr11,nc1, nr1(0) cal_wave_solv,poly_kx,poly_ky,nc21,nr21,nc1,(nr1(0)+nr2(imax-1))/2 cal_wave_solv,poly_kx,poly_ky,nc31,nr31,nc1, nr2(imax-1) cal_wave_solv,poly_kx,poly_ky,nc12,nr12,nc2, nr1(0) cal_wave_solv,poly_kx,poly_ky,nc22,nr22,nc2,(nr1(0)+nr2(imax-1))/2 cal_wave_solv,poly_kx,poly_ky,nc32,nr32,nc2, nr2(imax-1) rowfrst(n)=max([ 0,nr11,nr12]) rowlast(n)=min([ 359,nr31,nr32]) colfrst(n)=max([ 0,min([nc11,nc21,nc31])]) collast =min([1023,max([nc12,nc22,nc32])]) coldelt(n)=fix(ws.k.tdelt(1,n)) colact(n) =fix(ws.k.tsize(1,n)) colngrp(n)=(collast-colact(n)+1-colfrst(n))/coldelt(n) + 1 endfor rowfrst=max(rowfrst) rowlast=min(rowlast) rowact =fix(ws.k.tsize(0,0)) rowdelt=fix(ws.k.tdelt(0,0)) rowngrp=(rowlast-rowact+1-rowfrst)/rowdelt + 1 row1 =rowfrst+indgen(rowngrp)*rowdelt row2 =row1+rowact-1 colntot=total(colngrp) data=fltarr(rowngrp,colntot,ws.k.expcount) ; tit='Wavelength Calibration' progr_msg='Exposures processed' PROGRESS_BAR_SG,ws.k.expcount,tit,progr_msg,bar_frq,bar,STAGE='Start',bcnt ; ; Loop over exposures: ; for k=0,ws.k.expcount-1 do begin PROGRESS_BAR_SG,ws.k.expcount,tit,progr_msg,bar_frq,bar,STAGE='Loop',bcnt,k ; print,'Exposure nr. ',k ; ; Generate full-scale image for exposure k, and perform distortion ; correction: ; a=fltarr(1024,360) for n=0,ndata-1 do begin fact=1.0/(ws.k.tsize(0,0)*ws.k.tsize(1,n)) for jj=0,ws.k.tdim(1,n)-1 do begin j=ws.k.en(n)+jj nc1=nint(ws.k.trval(1,n)+jj*ws.k.tdelt(1,n)-dcol(n)) nc2=nint(ws.k.trval(1,n)+jj*ws.k.tdelt(1,n)+dcol(n)) for i=0,imax-1 do a(nc1:nc2,nr1(i):nr2(i))=ws.d(i,j,k)*fact endfor endfor a=poly_2d(a,poly_kx,poly_ky,1) ; ; Resample image according to modified masking/binning parameters: ; j=0 for n=0,ndata-1 do begin for jj=0,colngrp(n)-1 do begin col1=colfrst(n)+jj*coldelt(n) col2=col1+colact(n)-1 for i=0,rowngrp-1 do data(i,j,k)=total(a(col1:col2,row1(i):row2(i))) j=j+1 endfor endfor ; ; Define wavelength scale (separate for each exposure): ; g=float(ws.f(k).grtpos)/100000. for det=detp,detr do begin i=det-detp dw =ws.c.(det).wave.dw num=ws.c.(det).wave.num dum=0.0 for j=0,num-1 do dum=dum+ws.c.(det).wave.val(j)*g^j ws.f(k).wrval(i)=ws.c.(det).wave.ref-dum*dw ws.f(k).wdelt(i)=dw endfor ; ; End loop over exposures: ; endfor PROGRESS_BAR_SG,ws.k.expcount,tit,progr_msg,bar_frq,bar,STAGE='End' ; ; Update keywords for the new (POS,WAV) coordinate system: ; for n=0,ndata-1 do begin ws.k.tdim(0,0) =rowngrp ws.k.tdim(1,n) =colngrp(n) ws.k.en(n+1) =ws.k.en(n)+ws.k.tdim(1,n) ws.k.tdesc(0,n)='POS' ws.k.trval(0,n)=ref_scl*(float(rowfrst)+drow - ref_row) ws.k.tdelt(0,n)=ref_scl* float(rowdelt) ws.k.tsize(0,n)=ref_scl* float(rowact) ws.k.trval(1,n)=float(colfrst(n))+dcol(n) endfor ; ; Update "ws" data structure: ; ws={k: ws.k, f: ws.f, c: ws.c, d: data, b: ws.b} stat='sp_wav' ws.k.status=stat ; end ;------------------------------------------------------------------------- ; Compute corrected pixel position (x0,y0) from raw position (xi,yi). ;------------------------------------------------------------------------- pro CAL_WAVE_SOLV,kx,ky,x0,y0,xi,yi xf=float(xi) yf=float(yi) xx0=xf yy0=yf CAL_WAVE_EVAL,kx,ky,xx0,yy0,xxi,yyi dxi=xxi-xf & dyi=yyi-yf xx0=xx0-dxi & yy0=yy0-dyi iter=0 while abs(dxi) gt 0.1 or abs(dyi) gt 0.1 do begin CAL_WAVE_EVAL,kx,ky,xx0,yy0,xxi,yyi dxi=xxi-xf & dyi=yyi-yf xx0=xx0-dxi & yy0=yy0-dyi iter=iter+1 if iter gt 10 then begin POP_UP,'Error','No convergence in procedure CAL_WAVE_SOLV' return endif endwhile x0=nint(xx0) y0=nint(yy0) end ;------------------------------------------------------------------------- ; Evaluate polynomial describing raw pixel position (xi,yi) ; as function of corrected position (x0,y0) on XDL detector: ; ; xxi = SUM(n=0,num) SUM(m=0,num) Kx(n,m) * x0^m * y0^n , ; ; yyi = SUM(n=0,num) SUM(m=0,num) Ky(n,m) * x0^m * y0^n . ; ;------------------------------------------------------------------------- pro CAL_WAVE_EVAL,kx,ky,xx0,yy0,xxi,yyi siz=size(kx) num=siz(1)-1 dum=1.0 xxi=0.0 yyi=0.0 for n=0,num do begin dum1=dum for m=0,num do begin xxi=xxi+kx(n,m)*dum1 yyi=yyi+ky(n,m)*dum1 dum1=dum1*xx0 endfor dum=dum*yy0 endfor end ;------------------------------------------------------------------------- ; Perform Configuration Calibration: ; ; Oct 27 2K Finally Introduce PICKFILE Silvio Giordano ; Jan 10 2002 Consistency with DAS33 Silvio ; Jun 19,2002 Correction below 1.74 ; Oct 24 2003 if on IDL version for STRPOS use ; Oct 21 2004 X-talk correction - S. Giordano ;------------------------------------------------------------------------- pro SPA_CAL_CONF,ws,stat,path,file common uvcs_gen,cal_gen,spvl_gen,flat_gen,dark_gen,ima_gen common rsun, rsun common xtalk,tai_xtable_lya,grt_xtable_lya,tai_xtable_ovi,grt_xtable_ovi,xtalk_timestamp ; ; Verify calibration status: ; stat1=strmid(stat,0,6) if stat1 ne 'sp_raw' and stat1 ne 'sp_drk' and stat1 ne 'sp_flt' and $ stat1 ne 'vl_raw' then begin POP_UP,'Error','Operation not allowed' return endif ; if stat eq 'sp_raw_conf' OR stat eq 'vl_raw_conf' then begin ; SG 04 POP_UP,'Error','Configuration Calibration has been already performed' return endif spawn,'ls -1 ../CAL/D.*',lst, /sh if n_elements(lst) eq 0 then begin POP_UP,'Error','Cannot find calibration files in ../CAL/' return endif cal_path1 = '../CAL/' ; calculate current data's julian day (starting 1/1/1958) jday_cur = (ws.k.tai_obs/86400.) j = 0 done = 0 repeat begin cfile = lst(j) ; strip off path if FLOAT(!version.release) ge 5.3 then $ cfile=STRMID(cfile,STRPOS(cfile,'/',/REVERSE_SEARCH)+1) else $ cfile=STRMID(cfile,RSTRPOS(cfile,'/')+1) ; get julian day for each cal file year1 = strmid(cfile, strlen(cfile) - 10, 4) month1 = strmid(cfile, strlen(cfile) - 5, 2) day1 = strmid(cfile, strlen(cfile) - 2, 2) jday1 = julday(month1, day1, year1)-julday(1, 1, 1958, 0, 0) if jday1 gt jday_cur then begin cal_file2 = cfile done = 1 endif else cal_file1 = cfile j = j+1 endrep until ((j eq n_elements(lst)) or (done eq 1)) if done eq 0 then begin cal_file2 = cal_file1 print, "Using single most recent calibration file: ", cal_file1 endif else begin print, "Using calibration files: ", cal_file1, ", ", cal_file2 endelse cal_file_str = cal_file1 + ' ; ' + cal_file2 CAL_READ,ws,cal_path1,cal_file_str ; ; Calibrate ROLANGL: ; ws.f.rolangl=0.0 delta=ws.f.roll-ws.c.ins.roll.ref for i=0,ws.c.ins.roll.num-1 do $ ws.f.rolangl=ws.f.rolangl+ws.c.ins.roll.val(i)*delta^(i+1) ; ; Calibrate POSX1 and POSX2: ; ws.f.posx1=0.0 ws.f.posx2=0.0 delta1=ws.f.ptgx1-ws.c.ins.ptg.x1ref delta2=ws.f.ptgx2-ws.c.ins.ptg.x2ref for i=0,ws.c.ins.ptg.num-1 do begin ws.f.posx1=ws.f.posx1+ws.c.ins.ptg.x1val(i)*delta1^(i+1) ws.f.posx2=ws.f.posx2+ws.c.ins.ptg.x2val(i)*delta2^(i+1) endfor ; ; Compute angular offset (INS_Y0, INS_Z0) of UVCS roll axis, ; and instrument roll angle INS_ROLL, relative to spacecraft ; reference frame: ; ws.f.ins_y0=0.0 ws.f.ins_z0=0.0 for j=0,ws.c.ins.axis.num-1 do begin delta2=ws.f.posx2^j for i=0,ws.c.ins.axis.num-1 do begin product=delta2*ws.f.posx1^i ws.f.ins_y0=ws.f.ins_y0+ws.c.ins.axis.yval(i,j)*product ws.f.ins_z0=ws.f.ins_z0+ws.c.ins.axis.zval(i,j)*product endfor endfor ws.f.ins_roll=ws.c.ins.axis.roll-ws.f.rolangl ; ; Compute pointing coordinates (SC_YR, SC_ZR) of the spacecraft ; optical axis, relative to the rotating instrument reference ; frame: ; sin_ins_roll=sin(0.017453293*ws.f.ins_roll) cos_ins_roll=cos(0.017453293*ws.f.ins_roll) ws.f.sc_yr=-ws.f.ins_y0*sin_ins_roll-ws.f.ins_z0*cos_ins_roll ws.f.sc_zr= ws.f.ins_y0*cos_ins_roll-ws.f.ins_z0*sin_ins_roll ; ; Calibrate mirror angle (MIRANGL): ; ws.f.mirangl=2.0 delta=ws.f.mirpos-ws.c.ins.mirpos.ref for i=0,ws.c.ins.mirpos.num-1 do $ ws.f.mirangl=ws.f.mirangl+ws.c.ins.mirpos.val(i)*delta^(i+1) ; Mirror-Gratings X-Talk effect Correction DP 2006 ; Quadratic xtalk: updated using 1997 XTalk memo (S. Fineschi et al.) ; Same xtalk as in planner tool. ;; ;X-Talk correction rsun=969.6 ; solar radius in arcseconds lyagrt0=128000. ; reference position of LYA grating ovigrt0=176000. ; reference position of OVI grating xfact1=-4.68419e-7 ; linear term (units of solar radii per grating step) xfact2=1.73102e-12 ; quadratic term (solar radii per (grt step)^2) ; ; Read ancillary table print,'SPA_CAL_CONF%% Read ancillary tables for x-talk correction' if N_ELEMENTS(tai_xtable_lya) eq 0 then CAT_READ_XTALK_TABLES if xtalk_timestamp lt ws.k.tai_end then begin txt = strarr(4) txt(0) = 'Crosstalk correction not performed:' txt(1) = 'crosstalk auxiliary files are older than this data set.' txt(2) = 'Newest crosstalk files are available on the web at:' txt(3) = 'http://cfa-www.harvard.edu/uvcs/get_involved/das40.html' POP_UP, 'Warning', txt goto, xtalk_out endif ; ; UV Detectors ; if ws.k.ext eq 'DET_UV' then begin if ws.k.detector eq 'LYA' then begin tai=tai_xtable_ovi grt=grt_xtable_ovi endif if ws.k.detector eq 'OVI' then begin tai=tai_xtable_lya grt=grt_xtable_lya endif ;help,tai,grt ;help,ws.f.tai_xobs ;print,LONG(ws.f(0).tai_xobs) ;stp ; ; loop over the exposures ; for ex=0,ws.k.expcount-1 do begin diff=LONG(ws.f(ex).tai_xobs+ws.f(ex).exptime/2.) - LONG(tai) pastID=where(diff ge 0.,cnt) if cnt ne 0 then tmp=MIN(diff(pastID),mm) ; if cnt eq 0 then begin text1='SPA_CAL_CONF Procedure ' text2='The grating position data for x-talk correction are not available' text=[text1,text2] POP_UP,'Warning',text endif if ws.k.detector eq 'LYA' then begin lyagrt=ws.f(ex).grtpos ovigrt=grt(mm) endif if ws.k.detector eq 'OVI' then begin ovigrt=ws.f(ex).grtpos lyagrt=grt(mm) endif ; print,' lyagrt = ',lyagrt ; print,' ovigrt = ',ovigrt ; DP 2006 dmir=(lyagrt-lyagrt0)*xfact1 + ((lyagrt-lyagrt0)^2)*xfact2 + $ (ovigrt-ovigrt0)*xfact1 + ((ovigrt-ovigrt0)^2)*xfact2 ; print, "dmir = ", dmir ws.f(ex).mirangl=ws.f(ex).mirangl+dmir endfor endif ; ; VL Detector ; if ws.k.ext eq 'DET_VL' then begin ; tailya = tai_xtable_lya grtlya_all = grt_xtable_lya taiovi = tai_xtable_ovi grtovi_all = grt_xtable_ovi ; ; loop over the exposures ; for ex=0,ws.k.expcount-1 do begin difflya=LONG(ws.f(ex).VLSTRT(0)) - LONG(tailya) pastID=where(difflya ge 0.,cnt) if cnt ne 0 then tmp=MIN(difflya(pastID),mmlya) if cnt eq 0 then print, $ 'SPA_CAL_CONF%% grtpos data for x-talk correction not available' lyagrt=grtlya_all(mmlya) diffovi=LONG(ws.f(ex).VLSTRT(0)) - LONG(taiovi) pastID=where(diffovi ge 0.,cnt) if cnt ne 0 then tmp=MIN(diffovi(pastID),mmovi) if cnt eq 0 then print, $ 'SPA_CAL_CONF%% grtpos data for x-talk correction not available' ovigrt=grtovi_all(mmovi) dmir=(lyagrt-lyagrt0)*xfact1 + ((lyagrt-lyagrt0)^2)*xfact2 + $ (ovigrt-ovigrt0)*xfact1 + ((ovigrt-ovigrt0)^2)*xfact2 ws.f(ex).mirangl=ws.f(ex).mirangl+dmir endfor endif print,'%%% SPA_CAL_CONF - X-talk Correction' ;for i=0,ws.k.expcount-1 do print,i,' ',tmp0(i),ws.f(i).mirangl ;print,'' ;stp ; xtalk_out: ; ;for i=0,ws.k.expcount-1 do print,i,' ',tmp0(i),ws.f(i).mirangl ; ; Calibrate commanded mirror position (CMDMIR), which in DAS32 was ; the same as MIRANGL ; cmdmirposref = 18162. cmdmirpos = [2.951343E-04, $ -3.4267633E-10] ws.f.cmdmir=2.0 delta=ws.f.mirpos-cmdmirposref for i=0,n_elements(cmdmirpos) - 1 do $ ws.f.cmdmir=ws.f.cmdmir+cmdmirpos(i)*delta^(i+1) ; ; Calibrate occulter width (OCCWDTH): ; ws.f.occwdth=5.0 delta=ws.f.occpos-ws.c.ins.occ.ref for i=0,ws.c.ins.occ.num-1 do $ ws.f.occwdth=ws.f.occwdth+ws.c.ins.occ.val(i)*delta^(i+1) ; ; Calibrate sun sensor signals (not yet corrected for variable ; Sun-SOHO distance): ; rsun=969.6 ;Solar Radii from L1 point ;cb97 plus Marco if ws.k.expcount eq 1 then v_t=0.5 else v_t=fltarr(ws.k.expcount)+0.5 v_b=v_t & v_r=v_t & v_l=v_t for i=0,ws.c.ins.sun.num-1 do begin v_t=v_t+ws.c.ins.sun.top(i)*(ws.f.sunvt-ws.c.ins.sun.ref)^(i+1) v_b=v_b+ws.c.ins.sun.bot(i)*(ws.f.sunvb-ws.c.ins.sun.ref)^(i+1) v_r=v_r+ws.c.ins.sun.rht(i)*(ws.f.sunvr-ws.c.ins.sun.ref)^(i+1) v_l=v_l+ws.c.ins.sun.lft(i)*(ws.f.sunvl-ws.c.ins.sun.ref)^(i+1) endfor r_tb=(v_t-v_b)/(v_t+v_b) r_rl=(v_r-v_l)/(v_r+v_l) ws.f.sun_yr=rsun*(ws.c.ins.sun.q1*r_tb+ws.c.ins.sun.q3*r_tb^3)+ $ ws.c.ins.sun.yref ws.f.sun_zr=rsun*(ws.c.ins.sun.q1*r_rl+ws.c.ins.sun.q3*r_rl^3)+ $ ws.c.ins.sun.zref ; adjust mirror height for Lissajous pattern, using sun sensor data ; (DP 2006) ws.f.mirangl = ws.f.mirangl + ws.f.sun_yr/969.6 ; ; Detector selection: ; if ws.k.detector eq 'VLD' then det=1 else $ if ws.k.detector eq 'LYA' then det=2 else $ if ws.k.detector eq 'OVI' then det=3 else det=0 ; ; Determine INS_YR and INS_ZR (position of entrance slit in ; the instrument reference frame): ; ws.f.ins_yr=ws.c.(det).ref.yr+rsun*ws.f.mirangl ws.k.ins_zr=ws.c.(det).ref.zr ; ; Determine entrance slit width (SLTWDTH): ; if ws.k.detector eq 'LYA' or ws.k.detector eq 'OVI' then begin ws.f.sltwdth=0.05 delta=ws.f.sltpos-ws.c.(det).slt.ref for i=0,ws.c.(det).slt.num-1 do $ ws.f.sltwdth=ws.f.sltwdth+ws.c.(det).slt.val(i)*delta^(i+1) ; added very narrow (under 50 um) slit correction: 3/00 DP narrowArr = where(ws.f.sltpos lt 767, count) ;exposures with sltwdth < 50um if count ne 0 and ws.k.detector eq 'OVI' then begin ws.f(narrowArr).sltwdth=0 for i=0, ws.c.(det).slt.num2-1 do begin ws.f(narrowArr).sltwdth = ws.f(narrowArr).sltwdth + $ ws.c.(det).slt.val2(i)*(ws.f(narrowArr).sltpos)^(i) endfor ; -29.461+ 0.111974*(ws.f(narrowArr).sltpos) $ ; - (1.0959e-05)*(ws.f(narrowArr).sltpos) endif ; end addition DP 3/00 ; ; Determine MCP voltage (MCPVOLT): ; ws.f.mcpvolt=4600. delta=ws.f.mcpv-ws.c.(det).hvps.ref for i=0,ws.c.(det).hvps.num-1 do $ ws.f.mcpvolt=ws.f.mcpvolt+ws.c.(det).hvps.val(i)*delta^(i+1) endif ; ; Determine polarizer angle (POLANGL): ; if ws.k.detector eq 'VLD' then begin ws.f.polangl=0.0 delta=ws.f.polpos-ws.c.vld.pol.ref for i=0,ws.c.vld.pol.num-1 do $ ws.f.polangl=ws.f.polangl+ws.c.vld.pol.val(i)*delta^(i+1) ; ; Determine VLD high voltage (VLHVOLT): ; ws.f.vlhvolt=2000. delta=ws.f.vlhv-ws.c.vld.hvps.ref for i=0,ws.c.vld.hvps.num-1 do $ ws.f.vlhvolt=ws.f.vlhvolt+ws.c.vld.hvps.val(i)*delta^(i+1) endif ; ; Revise calibration status: ; if stat eq 'sp_raw' then stat='sp_raw_conf' if stat eq 'sp_drk' then stat='sp_drk_conf' if stat eq 'sp_flt' then stat='sp_flt_conf' if stat eq 'vl_raw' then stat='vl_raw_conf' ws.k.status=stat end ;----------------------------------------------------------------------- ; Procedure CAT_READ_XTALK_TABLES ; ; Purpose ; Read both ancillary tables for x-talk correction ; ; Author: ; Silvio Giordano (SG) ; ; History: ; Jun 25 2005 ;----------------------------------------------------------------------- pro CAT_READ_XTALK_TABLES ; common xtalk,tai_xtable_lya,grt_xtable_lya,tai_xtable_ovi,grt_xtable_ovi,xtalk_timestamp ; dfilelya='../CAL/xtalk_LYA.tab' dfileovi='../CAL/xtalk_OVI.tab' READ_XTALK_TABLE, tai_xtable_lya, grt_xtable_lya, dfilelya, timestamp_lya READ_XTALK_TABLE, tai_xtable_ovi, grt_xtable_ovi, dfileovi, timestamp_ovi if timestamp_ovi ne timestamp_lya then begin POP_UP, 'Warning', ['Timestamp not identical for OVI and LYA crosstalk files',$ 'Check to make sure you have the most recent crosstalk auxiliary files.'] endif ; pick earliest timestamp: xtalk_timestamp = (timestamp_lya < timestamp_ovi) return end ; ; ;----------------------------------------------------------------------- ; Procedure READ_XTALK_TABLE ; ; Author: ; Silvio Giordano (SG) ; D. Phillips ; History: ; Oct 21 2004 ; 2/2006 DP ;----------------------------------------------------------------------- pro READ_XTALK_TABLE,tai_xobs,grt,dfile,timestamp ; ; Read to define variables only ; n=0L & tmp1='' commentlines=3 ; lines of comments openr,unit,dfile,/get_lun while not EOF(unit) do begin readf,unit,tmp1 n=n+1 endwhile close,unit ; ; Define results variables nn=n-commentlines ; total lines of data nb=DBLARR(nn) & nl=LONARR(nn) tai_xobs = nb & grt = nl ; ; Read to fill variables ;tai_xobs|grtpos f0='(F11.0,A1,I6)' frm=f0 ; ; Read timestamp and header DP 06 openr,unit,dfile,/get_lun text = '' readf, unit, format='(A11,F11.0)',text, timestamp cmm=STRARR(2) readf,unit,cmm ; ; Define temporary variables tmp0=LONG(0) & tmp1=LONG(0) & spc0='' ; ; Read table values tit='Read '+dfile progr_msg='Records Loaded' PROGRESS_BAR_SG,nn,tit,progr_msg,bar_frq,bar,STAGE='Start',bcnt for i=0l, nn-1 do begin PROGRESS_BAR_SG,nn,tit,progr_msg,bar_frq,bar,STAGE='Loop',bcnt,i readf,unit,format=frm,tmp0,spc0,tmp1 tai_xobs(i) = tmp0 grt(i) = tmp1 endfor PROGRESS_BAR_SG,nn,tit,progr_msg,bar_frq,bar,STAGE='End' ; close,unit close,/all ; return end ; ; ;----------------------------------------------------------------------- ; Procedure SPA_OFFSET_CMP ; ; Purpose: ; Compute Offset from ws.f.ptgx1, ws.f.ptgx2 and ws.f.rolangl ; Computation has been extracted from planner2.pro Routine ; written by A. Modigliani, the coefficients are from L. Gardner. ; ; Input: ; ws ; ; Output: ; ws.f.mirangl pointing taking into account the offset ; ; called by ; MAIN MENU ; ; History: ; Aug 02 2002 from OFFSET_CMP written for catalog ; Oct 19 2004 ; ; Author: ; Silvio Giordano ;----------------------------------------------------------------------- pro SPA_OFFSET_CMP,ws,stat,path,file ; ; Verify calibration status: ; if stat eq 'sp_raw' then begin POP_UP,'Error',' Perform Configuration Calibration ' return endif ; ; Compute Polar Angle (ccw from North) from ws.f.rolangl ; if (ws.f(0).rolangl gt -180) and (ws.f(0).rolangl le 90) then $ pa = 90. - ws.f(0).rolangl else $ pa = 450. - ws.f(0).rolangl ; ra=pa/!RADEG ; ; ; Pointing Stage Positions X1=ws.f.ptgx1 X2=ws.f.ptgx2 ; ; Coefficients for calibration ;(from planner2.pro Routine) ; a1 = -0.117335 & a2 = -3.7179E-05 b1 = 0.16180 & c0 = 2921. X10 = 2920. & X20 = 2913. ; if pa ge 89. AND pa le 91. OR $ pa ge 269. AND pa le 271. then begin ya=(X1+X2)/2. - c0 ya0=(X10+X20)/2. - c0 offset = (a1*(ya-ya0) + a2*(ya^2.-ya0^2))/(sin(ra)) endif else begin offset = (b1*(X1-X2-X10+X20))/(2*cos(ra)) endelse ; off=offset*(60./960.) ; ; Modify Mirror Angle ws.f.mirangl title=' Offset Computation' text='Do You Want Apply Offset Correction to Pointing Calibration ?' POP_UP_YN, title, text, ans if ans eq 'yes' then ws.f.mirangl=ws.f.mirangl+off ; ;-------------------- ; ;print,'Offset =',offset,' arcminutes' ;print,'Offset =',off ,' rolar radii' ;print,ws.k.file ;print,'PA = ',pa,' X1, X2, = ',X1, X2,' OFFSET = ',off ;print,'CMDMIR = ',ws.f.cmdmir, $ ; ' MIRANGL = ',ws.f.mirangl, $ ; ' Pointing = ',ws.f.mirangl-off ;print,'' & stp ; ; return end ; ; ;--------------------------------------------------------------------- ; Extract parameter(s) from Calibration Parameter File: ;--------------------------------------------------------------------- function CAL_GET_PARAM,unit,varname,n1,n2,n3 if(unit le 0) then return,0 varname=strupcase(strtrim(varname,2)) ; ; Get variable name: ; CAL_GET_STRING,unit,a i=strpos(a,'=') if(i eq -1) then begin print,'Error reading calibration file, unit = ',unit print,'Expected variable ',varname,' but found:' print,'>',a,'<' stop endif name=strupcase(strtrim(strmid(a,0,i),2)) if(name ne varname) then begin print,'Error reading calibration file, unit = ',unit print,' expected variable ',varname,' but found ',name stop endif ; ; Get data from first line: ; data=strtrim(strcompress(strmid(a,i+1,strlen(a)-i-1)),2) n=strlen(data) ; ; Search for continuation character (& sign) ; and add continuation lines to data string: ; while(strmid(data,n-1,1) eq '&') do begin CAL_GET_STRING,unit,a if(strpos(a,'=') ne -1) then begin print,'Error reading calibration file, unit =',unit print,'Invalid continuation line:' print,'>',a,'<' stop endif data=strtrim(strcompress(strmid(data,0,n-1) + ' ' + a)) n=strlen(data) endwhile ; ; Extract values from "data" string: ; nmax=12 ; Changed from nmax=10 DP 12/00 since new primary LYA rad. calibration ; exceeds this. ndim=n_params()-2 if ndim eq 0 then begin if(strpos(varname,'NUM') eq -1) then value=0.0 else value=0l reads,data,value endif else begin if n1 lt 1 or n1 gt nmax then begin print,'Error reading calibration file, unit =',unit print,'Error: n1 out of range' stop endif if ndim eq 1 then begin temp =fltarr(n1) reads,data,temp value=fltarr(nmax) value(0:n1-1)=temp endif else begin if n2 lt 1 or n2 gt nmax then begin print,'Error reading calibration file, unit =',unit print,'Error: n2 out of range' stop endif if ndim eq 2 then begin temp =fltarr(n1,n2) reads,data,temp value=fltarr(nmax,nmax) value(0:n1-1,0:n2-1)=temp endif else begin if n3 lt 1 or n3 gt nmax then begin print,'Error reading calibration file, unit =',unit print,'Error: n3 out of range' stop endif temp =fltarr(n1,n2,n3) reads,data,temp value=fltarr(nmax,nmax,nmax) value(0:n1-1,0:n2-1,0:n3-1)=temp endelse endelse endelse return,value end ;----------------------------------------------------------------------- ; Read one line from calibration file. Skip blank lines and comment ; lines. Remove any comments from remainder of line. (Comments are ; indicated by the semi-colon character.) ;----------------------------------------------------------------------- pro CAL_GET_STRING,unit,a a='' readf,unit,a while(strlen(a) eq 0) do readf,unit,a a=strtrim(a,2) while(strmid(a,0,1) eq ';') do begin readf,unit,a a=strtrim(a,2) endwhile imax=strpos(a,';') if(imax lt 0) then imax=strlen(a) a=strmid(a,0,imax) end ;----------------------------------------------------------------------- ; Read INSTRUMENT calibration parameters. ;----------------------------------------------------------------------- pro CAL_READ_INS,unit,ins ; ; Read ROLL mechanism calibration parameters: ; ref=cal_get_param(unit,'CAL.INS.ROLL.REF') num=cal_get_param(unit,'CAL.INS.ROLL.NUM') val=cal_get_param(unit,'CAL.INS.ROLL.VAL',num) lim=cal_get_param(unit,'CAL.INS.ROLL.LIM') roll={roll,ref:ref,num:num,val:val,lim:lim} ; ; Read PTG mechanism calibration parameters: ; x1ref=cal_get_pa