;------------------------------------------------------------------------- ; ; UVCS "Extension" Data Analysis and processing Software (DAS) ; ; File: ext34.pro ("Extension code") ; ; Version: 34 ; ; Update to IDL version 5.0 on Aug. 13, 1997 (Carlo Benna) ; Silvio Giordano, Carlo Benna - 1995, 1996, 1997 ; ; Added '/sh' keyword to 'spawn' calls, to prevent certain possible ; conflicts with e.g. SSW - 10/00 Dan Phillips (DP) ; ; ;------------------------------------------------------------------------- ;------------------------------------------------------------------------- pro stp & st='' & read,'%Press Return to continue ',st & return & end ;------------------------------------------------------------------------- ;-------------------------------------------------------------------------; ; Procedure IMA_DISP ; ; Create and Realize Image Data Display Window ; ;-------------------------------------------------------------------------; pro IMA_DISP,ws,stat,path,file ws.k.wid_main=0 ; ; Create base widget: ; number=strcompress(ws.k.index,/remove_all) title ='Data Set nr. '+number+' -- File: '+path+file+' ('+stat+')' xbase=585 ybase=725 if max(ws.k.mirangls) ge 4. then xbase=ws.k.ncol_img+230 base =widget_base(title=title,group_leader=ws.k.wid_main, $ xsize=xbase,ysize=ybase,xoffset=450,yoffset=140,/column) ; ws.k.wid_disp=base ; ; Create widget image display: ; arow=widget_base(base,/row);/frame ; ; Draw widget size ; rmax=max(ws.k.mirangls + ws.k.wdth/2.) col=fix(rmax/ws.k.colwdth+0.5) ws.k.xdraw=col + 10 ; 5 left-right edges ws.k.ydraw=360 + 10 ; 5 pixels top-bottom edges im_draw_ima=widget_draw(arow,/button_events,uvalue='IMAG', $ xsize=ws.k.xdraw,ysize=ws.k.ydraw, $ x_scroll_size=xbase-60,y_scroll_size=370) ws.w.im_draw_ima=im_draw_ima ; ; Create buttons and sliders for image control: ; brow=widget_base(base,/row) acol=widget_base(brow,/column) crow=widget_base(acol,/row) drow=widget_base(acol,/row) ; ; 1) Button to quit display: ; button=widget_button(crow,value='QUIT',uvalue='QUIT', resource_name='green') ; null =widget_label(crow,value=' ') ; ; 2) Button to display pointing coordinates: ; button=widget_button(crow,value='PTNG',uvalue='PTNG', resource_name='red') ; ; 3) Pull-down menu for contour plot: ; desc=[{MENU,1,'CONTOUR' ,'MENU' }, $ {MENU,0,'10 levels' ,'CONT_10'}, $ {MENU,0,' 9 levels' ,'CONT_09' }, $ {MENU,0,' 8 levels' ,'CONT_08' }, $ {MENU,0,' 7 levels' ,'CONT_07' }, $ {MENU,0,' 6 levels' ,'CONT_06' }, $ {MENU,0,' 5 levels' ,'CONT_05' }, $ {MENU,0,' 4 levels' ,'CONT_04' }, $ {MENU,0,' 3 levels' ,'CONT_03' }] menu0=cw_pdmenu(crow,desc,uvalue=desc.proc) ; ; 4) Button to perform log filter: ; button=widget_button(drow,value='FLOG',uvalue='FLOG', resource_name='magenta') ; ; 5) Button to perform Contrast Enhancement: ; button=widget_button(drow,value='Cntr',uvalue='Cntr', resource_name='magenta') ; ; 6) Pull-down menu for Radial Filter: ; rad=[{MENU,1,'FRAD' ,'MENU' }, $ {MENU,0,'Linear' ,'RAD_1'}, $ {MENU,0,'Squared' ,'RAD_2'}, $ {MENU,0,'Cubic ' ,'RAD_3' }] menu3=cw_pdmenu(drow,rad,uvalue=rad.proc) ; ; 6) Pull-down menu for Image Smoothing: ; smo=[{MENU,1,'Smth' ,'MENU' }, $ {MENU,0,'2 pixels' ,'SMO_02'}, $ {MENU,0,'4 pixels' ,'SMO_04'}, $ {MENU,0,'8 pixels' ,'SMO_08'}, $ {MENU,0,'16 pixels' ,'SMO_16'}, $ {MENU,0,'32 pixels' ,'SMO_32' }] menu3=cw_pdmenu(drow,smo,uvalue=smo.proc) ; ; ; 7) Slider to select Image index: ; nimage=ws.k.nimage if nimage gt 1 then begin title ='Image ID {0 to '+strcompress(nimage-1,/remove_all)+'}' slider=widget_slider(acol,title=title,uvalue='NIMG', $ minimum=0,maximum=nimage-1) endif else begin label =widget_label(acol,value='Only one Image',/frame,resource_name='white') endelse ; ; 8) Slider to select Slit Position (row) ; for plot of image vs. Distance (column): ; if ws.k.rowngrp gt 1 then begin POS_SLIT_IMG,ws, y_img, ymin_img, ymax_img ymin=ROUND(ymin_img) ymax=ROUND(ymax_img) title ='Slit Pos. {'+strcompress(ymin,/remove_all)+' to '+ $ strcompress(ymax,/remove_all)+'} arcsec' ws.k.wid_ny=widget_slider(acol,title=title,uvalue='NYYY', $ minimum=ymin,maximum=ymax) endif else begin label =widget_label(acol,value='Only one Slit Position',/frame) endelse ; ; 9) Slider to select Radial Distance (col) ; for plot of image vs. Slit Position (row): ; POS_RSUN_IMG, ws, x_img, xmin_img, xmax_img, rmax if xmax_img gt rmax then xmax_img=rmax ; against Approx Problem xmin=ROUND(xmin_img*100)/100. xmax=ROUND(xmax_img*100)/100. title ='Distance {'+string(xmin,format='(G5.3)')+' to'+ $ string(xmax,format='(G5.3)')+'} R' ws.k.wid_nx=widget_slider(acol,title=title,uvalue='NXXX', $ minimum=xmin*100,maximum=xmax*100) ; erow=widget_base(acol,/row) ; ; 10) Pull-down menu for hardcopy: ; desc=[{MENU,1,'Hardcopy' ,'MENU' }, $ {MENU,0,'Coronal Scan Image' ,'IM_DRAW_IMA_H'}, $ {MENU,0,'Y vs. Radial Dist.' ,'IM_DRAW_Y' }, $ {MENU,0,'Y vs. Slit Pos.' ,'IM_DRAW_X' }] ;, $ ;{MENU,2,'Print Options ..' ,'PRNT_OPT' }] menu1=cw_pdmenu(erow,desc,uvalue=desc.proc) ; ; 12) Pull-down menu for info about Image or Fits file: ; about=[{MENU,1,'INFO' ,'MENU' }, $ {MENU,0,'About Image' ,'INFO_IMG'}, $ {MENU,0,'About Fits ' ,'INFO_FITS' }] menu2=cw_pdmenu(erow,about,uvalue=about.proc) ; ; Create plots: count vs. heliocentric distance (top) ; count vs. position along slit (bottom) ; bcol=widget_base(brow) im_draw_plt=widget_draw(bcol,x_scroll_size=330,xsize=330, $ y_scroll_size=270,ysize=580) ws.w.im_draw_plt=im_draw_plt ; ; Realize widgets: ; widget_control,/realize,base ; ; Make Images in "draw" widgets: ; widget_control,im_draw_ima,get_value=win_ima widget_control,im_draw_plt,get_value=win_plt ws.k.win_ima=win_ima ws.k.win_plt=win_plt ; ; default values for plots ws.k.nx=0 ws.k.nx_r=xmin ws.k.ny=ws.k.nrow_img-1 ws.k.ny_arc=ymin ws.k.log_fil=0 ws.k.smt_fil=0 ws.k.rad_fil=0 ws.k.cont_lev=0 ws.k.smooth=0 ; IM_DRAW_IMA,ws IM_DRAW_PLT,ws ; ; Put markers in border of 2D Image: x=ws.k.nx+ws.k.rminpx y=ws.k.ny+ws.k.yminpx IM_DISP_MARKER,ws,x,y ; ; Store "ws" structure in UVALUE of base widget: ; widget_control,base,set_uvalue=ws ; ; Register with XMANAGER: ; xmanager,'IMA_DISP',base,/just_reg end ;------------------------------------------------------------------------- ; Process Image Data Display Window Events ;------------------------------------------------------------------------- pro IMA_DISP_EVENT,ev ; ; Get parameters associated with the widget: ; widget_control,ev.id,get_uvalue=uvalue if strmid(uvalue(0),0,4) eq 'MENU' then uvalue=uvalue(ev.value) widget_control,ev.top,get_uvalue=ws ; ; Quit Display: ; if uvalue eq 'QUIT' then begin widget_control,ev.top,/destroy return endif ; ; Contour Plot: ; if strmid(uvalue,0,4) eq 'CONT' then begin if strcompress(ws.k.ipol(ws.k.nima),/rem) eq "NO" then begin POP_UP,'Error...','Image not good for Contour plot' return endif ws.k.cont_lev = fix(strmid(uvalue,5,2)) IM_DRAW_IMA,ws IM_DRAW_PLT,ws ws.k.cont_lev = 0 endif ; ; Process events from 2D Image (press events only): ; if uvalue eq 'IMAG' then begin if ev.press eq 0 then return rmaxpx=ws.k.rminpx+ws.k.ncol_img ymaxpx=ws.k.yminpx+ws.k.nrow_img if ev.x lt ws.k.rminpx or ev.x ge rmaxpx $ or ev.y lt ws.k.yminpx or ev.y ge ymaxpx then return ;print,'% Cursor position: x =',strcompress(ev.x),' y =',strcompress(ev.y) POS_SLIT_IMG,ws , y_img, ymin_img, ymax_img ws.k.ny=ev.y-ws.k.yminpx last=n_elements(y_img)-1 ws.k.ny_arc=y_img(last-ws.k.ny) POS_RSUN_IMG, ws, x_img, xmin_img, xmax_img, rmax ws.k.nx=ev.x-ws.k.rminpx ws.k.nx_r=x_img(ws.k.nx) if ws.k.nx_r gt rmax then ws.k.nx_r=rmax ; against Approx Problem ; Move markers in border of 2D Image to new location: IM_DISP_MARKER,ws,ev.x,ev.y ; Reset sliders for Slit Pos. and Radial Dist.: widget_control,ws.k.wid_ny,set_value=ws.k.ny_arc widget_control,ws.k.wid_nx,set_value=ROUND(ws.k.nx_r*100) ; Update plots: IM_DRAW_PLT,ws endif ; ; Display Pointing Coordinates button: ; if uvalue eq 'PTNG' then begin if ws.k.wid_ptng eq 0l then begin indx=strcompress(ws.k.index ,/remove_all) stat=strcompress(ws.k.status,/remove_all) path=strcompress(ws.k.path ,/remove_all) file=strcompress(ws.k.file ,/remove_all) title='Nr. '+indx+': '+path+file+' ('+stat+')' base=widget_base(title=title,group_leader=ws.k.wid_disp, $ xoffset=0,yoffset=150,/column) text=widget_text(base,value=' ',xsize=70,ysize=7, $ resource_name='white',/no_newline) base1=widget_base(base,/row) quit=widget_button(base1,value='QUIT',resource_name='green') wid_ima={disp: ws.k.wid_disp, text: text, quit: quit} widget_control,base,set_uvalue=wid_ima,/realize xmanager,'disp_ptng_ima',base,/just_reg ws.k.wid_ptng=base endif else widget_control,ws.k.wid_ptng,/show endif ; ; Logaritmic Filter: ; if uvalue eq 'FLOG' then begin ws.k.log_fil=1 ws.k.rad_fil=0 ws.k.smooth=0 IM_DRAW_IMA,ws IM_DRAW_PLT,ws endif ; ; Contrash Enhancement: ; if uvalue eq 'Cntr' then begin ws.k.smt_fil=1 ws.k.smooth=0 IM_DRAW_IMA,ws IM_DRAW_PLT,ws endif ; ; Radial Filter: ; if strmid(uvalue,0,4) eq 'RAD_' then begin ws.k.rad_fil=fix(strmid(uvalue,4,1)) ws.k.log_fil=0 ws.k.smooth=0 IM_DRAW_IMA,ws IM_DRAW_PLT,ws endif ; ; Image Smoothing: ; if strmid(uvalue,0,4) eq 'SMO_' then begin ws.k.smooth=fix(strmid(uvalue,4,2)) IM_DRAW_IMA,ws IM_DRAW_PLT,ws endif ; ; Hardcopy to printer: ; ;if strmid(uvalue,0,4) eq 'PRNT' then begin if strmid(uvalue,0,7) eq 'IM_DRAW' then begin widget_control,ev.top,/hourglass set_plot,'PS' device,/landscape !P.MULTI=[0,0,0,0,0] call_procedure,uvalue,ws device,/close das_prnt=getenv('DAS_PRNT') if das_prnt eq 'unknown' then POP_UP,'Error','Printer not selected' $ else spawn,'lpr -P'+das_prnt+' idl.ps', /sh ;DP 10/00 set_plot,'X' endif ; ; Info about selected Current Image or about all Images contained into Fits ; if strmid(uvalue,0,4) eq 'INFO' then begin call_procedure,uvalue,ws,text if uvalue eq 'INFO_IMG' then POP_UP,'Current Image INFO window',text if uvalue eq 'INFO_FITS' then POP_UP,'Data Set Images INFO window',text endif ; ; Process slider events: ; if strmid(uvalue,0,1) eq 'N' then begin widget_control,ev.top,/hourglass if uvalue eq 'NIMG' then begin POS_RSUN_IMG, ws, x_img, xmin_img, xmax_img xmin=ROUND(xmin_img*100)/100. POS_SLIT_IMG, ws, y_img, ymin_img, ymax_img widget_control,ws.w.im_draw_ima,get_value=win_ima ws.k.win_ima=win_ima ws.k.nima=ev.value ; Default values for plots: ws.k.ny=ws.k.nrow_img-1 & ws.k.ny_arc=ymin_img ws.k.nx=0 & ws.k.nx_r=xmin ; Reset sliders for Slit Position and Radial Distance: widget_control,ws.k.wid_ny,set_value=ws.k.ny_arc widget_control,ws.k.wid_nx,set_value=ws.k.nx_r*100 ; Update image and plots: ws.k.log_fil=0 ws.k.smt_fil=0 ws.k.rad_fil=0 ws.k.smooth=0 IM_DRAW_IMA,ws IM_DRAW_PLT,ws ; Reset markers: x=ws.k.nx+ws.k.rminpx y=ws.k.ny+ws.k.yminpx IM_DISP_MARKER,ws,x,y endif else begin widget_control,ws.w.im_draw_plt,get_value=win_plt ws.k.win_plt=win_plt if uvalue eq 'NXXX' then begin POS_RSUN_IMG, ws, x_img, xmin_img, xmax_img, rmax rr=ev.value/100. temp=min(ABS(x_img-rr),mn) ws.k.nx=mn ws.k.nx_r=rr endif if uvalue eq 'NYYY' then begin POS_SLIT_IMG, ws, y_img, ymin_img, ymax_img temp=min(ABS(y_img-ev.value),mn) ws.k.ny=ws.k.nrow_img-1-mn ws.k.ny_arc=ev.value endif ; Move markers: x=ws.k.nx+ws.k.rminpx y=ws.k.ny+ws.k.yminpx IM_DISP_MARKER,ws,x,y ; Update plots: IM_DRAW_PLT,ws endelse endif ; ; Display pointing coordinates: ; if ws.k.wid_ptng gt 0 then begin DISP_PTNG_TEXT_IMA,ws,text widget_control,ws.k.wid_ptng,get_uvalue=wid_ima widget_control,wid_ima.text,set_value=text endif ; ; Store revised "ws" in UVALUE of Display widget: ; widget_control,ev.top,set_uvalue=ws end ; ;--------------------------------------------------------------------- ; Event handler for display of pointing coordinates: ;--------------------------------------------------------------------- pro DISP_PTNG_IMA_EVENT,ev ; ; Close Pointing Display: ; widget_control,ev.top,get_uvalue=wid_ima if ev.id eq wid_ima.quit then begin widget_control,wid_ima.disp,get_uvalue=ws,/no_copy ws.k.wid_ptng=0 widget_control,wid_ima.disp,set_uvalue=ws,/no_copy widget_control,ev.top,/destroy endif end ; ;------------------------------------------------------------------------- ; Compute pointing coordinates in Instrument, Spacecraft and Solar ; reference frames: ;------------------------------------------------------------------------- pro DISP_PTNG_TEXT_IMA,ws,text ; text=strarr(5) ny_r=ws.k.ny_arc*ws.k.arc_r nx_dist=SQRT((ws.k.nx_r^2) +(ny_r^2)) pol_angl=ws.k.angle - !RADEG * ATAN(ny_r/ws.k.nx_r) if pol_angl lt 0 then pol_angl = 360.+ pol_angl if pol_angl ge 360 then pol_angl = pol_angl - 360 if ws.k.ttype(ws.k.nima) eq 'INT' then type='Intensity' if ws.k.ttype(ws.k.nima) eq 'MN1' then type='First Moment' if ws.k.ttype(ws.k.nima) eq 'MN2' then type=' !8T!Dkinetic!N!3' if ws.k.ttype(ws.k.nima) eq 'MN3' then type='Third Moment' pnt_val=ws.d(ws.k.nrow_img-1-ws.k.ny,ws.k.nx,ws.k.nima) if ws.k.ttype(ws.k.nima) eq 'INT' then text(0)=string(pnt_val, $ '("Intensity = ",E10.3," phot/(s*cm^2*sterad)")') if ws.k.ttype(ws.k.nima) eq 'MN1' then text(0)=string(pnt_val, $ '("1st Order Moment = ",E10.3," Angstrom")') if ws.k.ttype(ws.k.nima) eq 'MN2' then text(0)=string(pnt_val, $ '("2nd Order Moment = ",E10.3," Angstrom^2")') if ws.k.ttype(ws.k.nima) eq 'MN3' then text(0)=string(pnt_val, $ '("3rd Order Moment = ",E10.3," Angstrom^3")') text(1)=' ' text(2)=string(nx_dist, $ '("Heliocentric Dist. = ",f5.2, " Solar Radii")') text(3)=' ' text(4)=string(pol_angl, $ '("Polar Angle = ",f6.2, " Deg.")') end ; ;------------------------------------------------------------------------- ; Display markers in the border of 2D Image: ;------------------------------------------------------------------------- pro IM_DISP_MARKER,ws,x,y ; ; Select 2D Image window: ; wset,ws.k.win_ima ; ; Remove current "bottom" and "top" markers, and insert new markers: ; white=bytarr(9,5)+255 tv,white,ws.k.marker(0),0 tv,white,ws.k.marker(0),ws.k.nrow_img+5 ws.k.marker(0)=x-4 bottom=white top =white for i=0,4 do begin bottom(i:8-i, i)=0 top (i:8-i,4-i)=0 endfor tv,bottom,ws.k.marker(0),0 tv,top ,ws.k.marker(0),ws.k.nrow_img+5 ; ; Remove current "right" marker, and insert new marker: ; white=transpose(white) tv,white, ws.k.xdraw-5, ws.k.marker(3) ws.k.marker(3)=y right=transpose(top) ws.k.marker(3)=y-4 tv,right, ws.k.xdraw-5, ws.k.marker(3) end ; ; ;---------------------------------------------------------------------- ; function N_DIFF ; compute the number of the different values of a vector ;---------------------------------------------------------------------- function N_DIFF, vector ; index_tot = 0 & n_eq = 0 n = N_ELEMENTS(vector) for i=1, n-1 do begin a = where(index_tot eq i, c1) if c1 ne 0 then goto, jump index = where(vector eq vector(i), c2) n_eq = n_eq + c2 -1 index_tot = [index_tot, index] jump: endfor diff = n - n_eq return, diff end ; ; ;---------------------------------------------------------------------- ; function C_R_REPL ; ; Input: array matrix to replicate c colomns ; r rows ; ; c_fact c element vector ; replication factor for each column ; if c_fact=0 the columns will not replicate ; ; r_fact r element vector ; replication factor for each row ; if r_fact=0 the rows will not replicate ; ; Output: array new matrix (TOTAL(c_fact) x TOTAL(r_fact)) ; ; e.g: ; IDL> array=indgen(4,3) & c_fact=[3,2,1,3] & r_fact=[2,3,1] ; IDL> array=C_R_REPL(array,c_fact,r_fact) ; ; February, 25, 1995 ; ; revised: March 2 ; to allow for replication of a vector ;---------------------------------------------------------------------- function C_R_REPL, array, c_fact, r_fact ; col_fact = N_ELEMENTS(c_fact) row_fact = N_ELEMENTS(r_fact) s_array = size(array) ; if col_fact ne s_array(1) and total(c_fact) ne 0 then begin ; print, 'la funzione non ha parametri corretti' print, 'the function not have the correct parameters' array_repl = 0 goto, via endif ; if row_fact ne s_array(2) and total(r_fact) ne 0 then begin ; print, 'la funzione non ha parametri corretti' print, 'the function not have the correct parameters' array_repl = 0 goto, via endif ; ; rows replication ; if s_array(0) eq 1 or total(r_fact) eq 0 then begin ; (M2) array_temp=array goto, jump1 endif for i=0, s_array(2) - 1 do begin a_row = array(*,i) a_reb = TRANSPOSE(REBIN(a_row, s_array(1), r_fact(i))) if i eq 0 then ar_repl=a_reb else ar_repl=[ar_repl,a_reb] endfor a_reb=0 array_temp = TRANSPOSE(ar_repl) ; jump1: s_array = size(array_temp) if s_array(0) eq 1 then s_array(2)=1 ; (M2) ; ; columns replication ; if total(c_fact) eq 0 then begin array_repl = array_temp goto, via endif ; for j=0, s_array(1) - 1 do begin a_col = array_temp(j,*) a_reb = REBIN(a_col, c_fact(j), s_array(2)) if j eq 0 then array_repl=a_reb else array_repl=[array_repl,a_reb] endfor ; via: return, array_repl end ; ; ;-----------------------------------------------------------------------; ; Procedure NMN_RD ; ; Read Information about Expected Spectral Lines ; ; ; ; input: det ; ; ; ; output: spectral line (sp_line) ; ; nominal wavelength (wl_line) ; ; ; ; called by IM_MN1 ; ; IM2_MK_IMAG_EVENT ; ; ; ; Note: ; ; Doesn't work for redundant lines ; ; ; ; Last Revision: Apr 08 1998 ; ; Silvio Giordano ; ;-----------------------------------------------------------------------; pro NMN_RD, det, sp_line, wl_line if det eq 'LYA' then begin sp_line = ['C III ', 'C III ', 'C III ','Fe XIX', 'S X ','Si III','HI Lya','N V', 'Fe XII','Ne IX','Si II ','Ni XIII'] wl_line = [1175.71, 1175.99, 1176.37, 594. , 1196.25, 1206.51, 1215.67, 1238.82,1242.03, 1248., 1264.74, 1277.23] endif if det eq 'OVI' then begin sp_line = ['HI Lya','HI Lyb','O VI ','O VI ','He II ','Si XII','C II ','Si XII','He I ','C III ','C III ','C III ','S X', 'Si III','Mg X ','Fe XII','Mg X ','Fe XVIII','HI Lyg ','C III '] wl_line = [1215.67, 1025.72, 1031.91, 1037.61, 1084.98, 499.37, 1036.34, 520.66, 584.33, 1175.71, 1175.99, 1176.37, 1196.24, 1206.51, 609.76, 1242.00, 624.95 , 974. , 972.54 , 977.] endif return end ; ; ;----------------------------------------------------------------------- ; Procedure IM_COMP ; Compute Image requested by 'Make Images' and 'Make Fit Images' ; ; Inputs : ws, wsb (image structure and spectral data) ; ; Outputs: ws (image data) ; ; called by IM2_MK_IMAG ; IM2_MK_IMAG_FIT ; ; calls Procedures : ; LAMBDA ---> lmbd ; ; ARR_DEF ---> ws.k.nrow_img,ws.k.ncol_img ; ; IM_INT ---> dataexp = fltarr(tdim(0,0), expcount) ; IM_MN1 First Moment ; IM_MN2 Second Moment ; IM_MN3 Third Moment ; IM_IF1 Intensity from Gauss Fit with Instr corr ; ws.fit (Fit Results) ; IM_IF2 Intensity from 2 Gauss Fit with Instr corr ; IM_PGS Sigma from Pure Gauss Fit (no corr) ; IM_COMP_RAT Total counts ratio ; ; IM_DSCR --> idata = fltarr(ws.k.nrow_img,ws.k.ncol_img) ; IM_INTERP ; ; Purpose: ; Compute Image requested by 'Make Images' and 'Make Fit Images' ; ; Author: ; Silvio Giordano (SG) ; ; History: ; Sep 10 96 Bug introduced by distorsion correction ; "0:wsb.k.tdim(0,0)-1" instead of "*" ; see also im2_mk_imag ; Feb 19 97 ; Feb 24 98 Gauss fit with instrum. corr ---> sigma image "SGI" ; Pure Gauss fit ---> sigma image "SGP" ; Mar 31 98 ; Apr 17 98 SGI ---> GSI ; SGP ---> PGS ; Apr 24 98 new error computation ; Apr 27 98 new ratio error computation ; Apr 12 98 works with new rebinning (total bins) ; Apr 16 99 GSI ---> IF1 ; May 05 99 IF1, common ifit_res ; May 21 99 fix bug with new rebinning ; May 27 99 IM_COMP_RAT ; Feb 22 01 comments ; Mar 26 02 mi sono rotto cerco di farla funzionare anche con i fit ; Aug 30 02 analize by image fit the sit and stare also ; if ws.k.expcount ne 1 then begin ... ; Jan 14 03 new variable "out_opt" in common ifit_res ; ; Silvio Giordano ;----------------------------------------------------------------------- pro IM_COMP, ws, wsb ; common ifit_res,n_fit_res,out_opt ; ; Image Array Definition ; ARR_DEF, ws, wsb data = fltarr(ws.k.nrow_img, ws.k.ncol_img, ws.k.nimage) ddata = fltarr(wsb.k.tdim(0,0), ws.k.expcount, ws.k.nimage) err = fltarr(wsb.k.tdim(0,0), ws.k.expcount, ws.k.nimage) dataexp=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) datafit = fltarr(wsb.k.tdim(0,0),wsb.k.expcount, n_fit_res) all_fit_res = fltarr(wsb.k.tdim(0,0),ws.k.expcount,n_fit_res,ws.k.nimage) rowact=fix(((wsb.k.tdelt(0,0)*ws.k.arc_r)/ws.k.colwdth)+0.5) nrow_img_reb=wsb.k.tdim(0,0)*rowact data_reb = fltarr(nrow_img_reb, ws.k.ncol_img, ws.k.nimage) ; ; temporary array errexp=fltarr(wsb.k.tdim(0,0), ws.k.expcount) ; ; Keywords for image array ws.k.rowngrp= wsb.k.rowngrp ws.k.rowfrst= wsb.k.rowfrst ws.k.rowact= wsb.k.rowact ws.k.rowspc= wsb.k.rowspc ; ; Loop over images requested by "Make Images" ; for im=0, ws.k.nimage-1 do begin ; LAMBDA,wsb,0,ws.k.pan(im),wav ; ; Extract wavelength range (wmin,wmax) from panel ws.k.pan(im) ; col_sel = where (wav ge ws.k.wmin(im) and wav le ws.k.wmax(im),tdim_int) wav_sel = wav(col_sel) ; Keyword for image array ws.k.wmin(im)=min(wav_sel) ws.k.wmax(im)=max(wav_sel) if wsb.k.trcal(ws.k.pan(im)) eq 0 then begin n_wav=N_ELEMENTS(wav)-1 col_sel=REVERSE(n_wav-col_sel) wav_sel=REVERSE(wav_sel) endif ; ; Avoid Bug introduced by distorsion correction data_img = wsb.d(0:wsb.k.tdim(0,0)-1,wsb.k.en(ws.k.pan(im))+col_sel,*) ; Keyword (trcal) for image array ws.k.trcal(im) = wsb.k.trcal(ws.k.pan(im)) if ws.k.trcal(im) eq 1 then ws.k.wdelt(im)=ABS(wsb.f(0).wdelt(1)) else $ ws.k.wdelt(im)=ABS(wsb.f(0).wdelt(0)) ; ; Compute selected type of image ; print,'### IM_COMP ws.k.ttype(im): ',ws.k.ttype(im) print,'### IM_COMP ws.k.ttype(im): ',STRCOMPRESS(ws.k.ttype(im),/REM) case STRCOMPRESS(ws.k.ttype(im),/REM) of 'INT' : begin IM_INT,ws,wsb,tdim_int,data_img,dataexp,im,errexp end 'MN1' : begin IM_MN1,ws,wsb,wav_sel,data_img,dataexp,im,errexp end 'MN2' : begin IM_MN2,ws,wsb,wav_sel,data_img,dataexp,im,errexp end 'MN3' : begin IM_MN3,ws,wsb,wav_sel,data_img,dataexp,im if wsb.k.status NE 'sp_rad' then errexp(*,*)=0 else $ errexp(*,*)=0 end ; ;Select Fit type ; '1GaussI' : begin ans2g=1 ws.k.int_typ='1GI' print,'1 - Instrum. Corrected One Gaussian Fit' IM_IF1,ws,wsb,wav_sel,data_img,dataexp,im,datafit,ans2g end '2GaussI' : begin ans2g=2 ws.k.int_typ='2GI' print,'2 - Instrum. Corrected Two Components Gaussian Fit' IM_IF1,ws,wsb,wav_sel,data_img,dataexp,im,datafit,ans2g end '1GaussPeakI' : begin ans2g=6 ws.k.int_typ='1GP' print,'6 - Ins. Corr. One Gaussian Fit with fixed peak' IM_IF1,ws,wsb,wav_sel,data_img,dataexp,im,datafit,ans2g end '1GaussNI' : begin ans2g=4 ws.k.int_typ='1GN' print,'4 - Not Instrum. Corrected One Gaussian Fit' IM_IF1,ws,wsb,wav_sel,data_img,dataexp,im,datafit,ans2g end '2GaussNI' : begin ans2g=5 ws.k.int_typ='2GN' print,'5 - Not Instrum. Corrected Two Components Gaussian Fit' IM_IF1,ws,wsb,wav_sel,data_img,dataexp,im,datafit,ans2g end '1VoigtNI' : begin ans2g=3 ws.k.int_typ='1VN' print,'3 - Not Instrum. Corrected Voigt Fit' IM_IF1,ws,wsb,wav_sel,data_img,dataexp,im,datafit,ans2g end endcase ; ; Ratio image ; if ws.k.pan1(im) ne -1 then IM_COMP_RAT,ws,wsb,im,dataexp,errexp ; ; Image Interpolation ; if ws.k.expcount ne 1 then begin ;print,'CASO GENERALE' case strcompress(ws.k.ipol(im),/remove_all) of "NO" : IM_DSCR, ws, wsb, dataexp, idata "YES" : IM_INTERP, ws, wsb, dataexp, idata endcase size_d=SIZE(data) size_i=SIZE(idata) ; if size_d(1) eq size_i(1) then data(*,*,im) = idata $ else data_reb(*,*,im) = idata ; ddata(*,*,im) = dataexp err(*,*,im) = errexp all_fit_res(*,*,*,im) = datafit ; endif else begin ;print,'CASO ONE MIRROR' if ws.k.nimage eq 1 then begin ;print,'CASO ONE IMAGE' ddata(*,*,im)= dataexp err(*,*,im)= errexp all_fit_res(*,*,*,im) = datafit endif else begin ;print,'CASO TWO IMAGES' ddata(*,*,im) = dataexp err(*,*,im) = errexp all_fit_res(*,*,*,im) = datafit endelse endelse endfor ; size_d=SIZE(data) size_i=SIZE(data_reb) if size_d(1) ne size_i(1) then begin data = data_reb ws.k.nrow_img=size_i(1) ; 21/05/99 endif ; DEF_WS_FIT,ws,all_fit_res ; widg={WIDG} ws={k: ws.k, d: data, dd:ddata, err: err, w: widg, fit: ws.fit} ;ws={k: ws.k, d: data, dd:ddata, err: err, w: widg} ; OLD since Apr 16 99 via: return end ; ; ;----------------------------------------------------------------------- ; Procedure DEF_WS_FIT ; Fill values of structure ws.fit ; ; Inputs : ws, all_fit_res ; ; Outputs: ws.fit ; ; Called by IM_COMP ; ; May 04 99 ; May 12 99 error fields ; May 13 99 ; May 26 99 ws.fit.ifbin ; Jun 02 04 2nd gaussian center added fit.lamb and e_lamb ; ; Silvio Giordano ;----------------------------------------------------------------------- pro DEF_WS_FIT,ws,all_fit_res ; ws.fit.dist(*,*) =all_fit_res(*,*,0,0) ws.fit.theta(*,*) =all_fit_res(*,*,1,0) ws.fit.ifbin(*,*,*) =all_fit_res(*,*,2,*) ws.fit.chi(*,*,*) =all_fit_res(*,*,3,*) ws.fit.lamb(*,*,*) =all_fit_res(*,*,4,*) ws.fit.e_lamb(*,*,*) =all_fit_res(*,*,5,*) ws.fit.sig(*,*,*) =all_fit_res(*,*,6,*) ws.fit.e_sig(*,*,*) =all_fit_res(*,*,7,*) ws.fit.vel1e(*,*,*) =all_fit_res(*,*,8,*) ws.fit.e_vel1e(*,*,*) =all_fit_res(*,*,9,*) ws.fit.tk1(*,*,*) =all_fit_res(*,*,10,*) ws.fit.e_tk1(*,*,*) =all_fit_res(*,*,11,*) ws.fit.peak(*,*,*) =all_fit_res(*,*,12,*) ws.fit.e_peak(*,*,*) =all_fit_res(*,*,13,*) ws.fit.areag(*,*,*) =all_fit_res(*,*,14,*) ws.fit.e_areag(*,*,*) =all_fit_res(*,*,15,*) ws.fit.bck(*,*,*) =all_fit_res(*,*,16,*) ws.fit.lamb2(*,*,*) =all_fit_res(*,*,17,*) ws.fit.e_lamb2(*,*,*) =all_fit_res(*,*,18,*) ws.fit.e_bck(*,*,*) =all_fit_res(*,*,19,*) ws.fit.sig2(*,*,*) =all_fit_res(*,*,20,*) ws.fit.e_sig2(*,*,*) =all_fit_res(*,*,21,*) ws.fit.vel1e2(*,*,*) =all_fit_res(*,*,22,*) ws.fit.e_vel1e2(*,*,*)=all_fit_res(*,*,23,*) ws.fit.tk2(*,*,*) =all_fit_res(*,*,24,*) ws.fit.e_tk2(*,*,*) =all_fit_res(*,*,25,*) ws.fit.peak2(*,*,*) =all_fit_res(*,*,26,*) ws.fit.e_peak2(*,*,*) =all_fit_res(*,*,27,*) ws.fit.areag2(*,*,*) =all_fit_res(*,*,28,*) ws.fit.e_areag2(*,*,*)=all_fit_res(*,*,29,*) ws.fit.rat12(*,*,*) =all_fit_res(*,*,30,*) ws.fit.e_rat12(*,*,*) =all_fit_res(*,*,31,*) return end ; ;----------------------------------------------------------------------; ; Procedure LAMBDA ; ; Compute array of wavelengths for selected exposure and panel ; ; ; ; Inputs : ws ; ; j exposure index ; ; n panel index ; ; ; ; Outputs: lmbd wavelength array ; ; ; ; called by IM_COMP ; ; called by MOUSE ; ; ; ; Silvio Giordano ; ;----------------------------------------------------------------------; ; pro LAMBDA,ws,j,n,lmbd ; t=ws.k.trcal(n) lmbd = ws.f(j).wrval(t) + ws.f(j).wdelt(t) * $ (ws.k.trval(1,n) + ws.k.tdelt(1,n) * indgen(ws.k.tdim(1,n))) ; ;Note: if LYA or OVI primary then lmbd(0) is max ===> reverse ; only if OVI redundant then lmbd(0) is min if t eq 0 then lmbd=REVERSE(lmbd) end ; ;----------------------------------------------------------------------- ; Procedure IM_COMP_RAT ; ; Inputs : ws ; wsb ; im ; ; Outputs: dataexp ; errexp ; ; called by IM_COMP ; ; Calls Procedures : LAMBDA ; IM_INT ; Purpose: ; Compute image ratio from total counts ; ; Author: ; Silvio Giordano (SG) ; ; History: ; May 27 1999 (SG) ; May 23 2003 Bug (?) removed in call to LAMBDA ;----------------------------------------------------------------------- ; pro IM_COMP_RAT,ws,wsb,im,dataexp,errexp ; LAMBDA,wsb,0,ws.k.pan1(im),wav ; ; Extract wavelength range (wmin1,wmax1) from panel ws.k.pan1(im) ; col_sel = where (wav ge ws.k.wmin1(im) and wav le ws.k.wmax1(im),tdim_int1) wav_sel = wav(col_sel) ; Keyword for image array ws.k.wmin1(im)=min(wav_sel) ws.k.wmax1(im)=max(wav_sel) if wsb.k.trcal(ws.k.pan(im)) eq 0 then begin n_wav=N_ELEMENTS(wav)-1 col_sel=REVERSE(n_wav-col_sel) wav_sel=REVERSE(wav_sel) endif data_img1 = wsb.d(0:wsb.k.tdim(0,0)-1, wsb.k.en(ws.k.pan1(im))+col_sel,*) ; intensity of denominator line errexp1=fltarr(wsb.k.tdim(0,0), ws.k.expcount) IM_INT,ws,wsb,tdim_int1,data_img1,dataexp1,im,errexp1 dataexp1=dataexp1>1 ; ; ratio rt=dataexp/dataexp1 ; ratio error err_rat=SQRT((1./dataexp1)^2*errexp^2+(dataexp/dataexp1^2)^2*errexp1^2) dataexp=rt & errexp=err_rat ws.k.ttype(im)='RAT' return end ;-----------------------------------------------------------------------; ; Procedure ARR_DEF ; ; Define Image Array Dimension ; ; ; ; Input : wsb (spectral data structure) ; ; ; ; Outputs: ws.k.nrow_img (image array rows number) ; ; ws.k.ncol_img (image array columns number) ; ; ; ; Called by IM_COMP ; ; ; ; Calls Procedure POS_SLIT ; ; EXP_NOEXP ; ; ; ; Calls Function N_DIFF ; ; ; ; Defines Value of Keyword ws.k.colwdth ; ; ws.k.arc_r ; ; ws.k.mm_r ; ; ws.k.expcount ; ; ws.k.noe_wdth [Solar Radii] ; ; ws.k.mirangls [Solar Radii] ; ; ws.k.wdth [Solar Radii] ; ; ws.k.exptimes [sec] ; ; ; ; Feb 19 1997 correct alpha computation ; ; Nov 27 1997 ; ; Apr 24 1998 comments ; ; Apr 19 1999 comments ; ; Dec 28 2001 update to DAS33 DP 01 ; ; Jan 23 2002 consistency with DAS33: cmdmir used below 1.74 R ; ; Jun 19 2002 re-introduce mirangl below 1.74 R because of my ; ; correction in configuration calibration ; ; Aug 02 2002 Sort exposures by using increasing MIRANGLS, not CMDMIR ; ; Aug 30 2002 analize by image fit the sit and stare also ; ; if ws.k.expcount ne 1 then begin ... ; ; ; ; Silvio Giordano ; ;-----------------------------------------------------------------------; pro ARR_DEF, ws, wsb ; ; 1/960~ converts from arcsec to Solar Radii ; from L1 : 1/969.312 ws.k.arc_r=0.00103166 R=6.9598e+10 ; Solar Radius [cm] L=1.481019131e+13 ; L1-Sun [cm] alpha=!RADEG*ASIN(R/L)*60*60 ws.k.arc_r=1/alpha ; ; 0.286~ converts from mm to Solar Radii ;ws.k.mm_r=0.28372725 ; IM_SCALE=0.0036361026 F=750 ; UVCS Focus [mm] IM_SCALE=(2*!dpi*F)/360. IM_SCALE=IM_SCALE/(60*60) ws.k.mm_r=ws.k.arc_r/IM_SCALE ; ; Choose linear size of the image pixel in Solar Radii ; this number maintains 360 pixels along tg direction if mask gets ; full detector along this direction (old: ws.k.colwdth=0.00737) ; PROBLEM: to know exactly along the slit range [arcsec] ; OLD: with our SPA FITS the range in arcsec (of the detector) is too ; wide: 2547.30 (from data), then below I use: det_h=2475.177681 ; ws.k.colwdth=0.00700567 ;DET=9 ; Detector Height [mm] ;det_h=DET/IM_SCALE ; Detector Height [arcsec] ;det_h=2547.30 ; array of positions along slit [Solar Radii] ; ; OK only if using full detector mask ;POS_SLIT,ws, poslit, ymin, ymax ;det_h=ymax-ymin ; ; for all masks, it is necessary know det_h if wsb.k.detector eq 'OVI' then det_h=2520.00 ; with flight OVI FITS if wsb.k.detector eq 'LYA' then det_h=2520.00 ; with flight LYA FITS ws.k.colwdth=(det_h/360)*ws.k.arc_r ; ; ************** Image array rows number ************ ; ; array of positions along slit [Solar Radii] POS_SLIT,ws, poslit, ymin, ymax ymin_r=ws.k.arc_r*ymin ymax_r=ws.k.arc_r*ymax nrowimg=fix((ymax_r-ymin_r)/ws.k.colwdth+0.5) ws.k.nrow_img=nrowimg ; ; ************** Image array columns number ********** ; ; sol_r = fltarr(ws.k.expcount) exp_wdth = fltarr(ws.k.expcount) ; exp_wdth = ws.k.mm_r * wsb.f.sltwdth ; ; sort exposures for increasing distance ; ord = SORT(wsb.f.mirangl) pointings=wsb.f.mirangl ;SG 02 ;ord = sort(wsb.f.cmdmir) ;DP 01 ;ws.k.mirangls = wsb.f(ord).cmdmir ; [Solar Radii] ;DP 01 ; ws.k.mirangls = pointings(ord) ;SG 02b ; ws.k.wdth = exp_wdth(ord) ; [Solar Radii] ws.k.exptimes = wsb.f(ord).exptime ; [sec] sol_r = ws.k.mirangls exp_wdth = ws.k.wdth(0:ws.k.expcount-1) ; ; calculate non-exposure widths [solar radii] ; if ws.k.expcount gt 1 then begin zeri_wdth=fltarr(ws.k.expcount-1) for i=0, ws.k.expcount - 2 do $ zeri_wdth(i) = (sol_r(i+1)-exp_wdth(i+1)/2) - $ (sol_r(i)+exp_wdth(i)/2) ws.k.noe_wdth=zeri_wdth ; ; Compute exp_zeri_wdth (exposures and non-exposures widths) EXP_NOEXP, ws, exp_zeri_wdth ; ; calculate # of columns for every exposures and non-exposures colimg=fix((exp_zeri_wdth/ws.k.colwdth)+0.5) ws.k.ncol_img = total(colimg) endif else begin ws.k.noe_wdth=0 ws.k.ncol_img=1 endelse ; return end ;-----------------------------------------------------------------------; ; Procedure POS_SLIT ; ; Compute image range along the slit in arcsec ; ; ; ; Inputs : ws ; ; ; ; Outputs: poslit array of the positions along the slit ; ; ymin minimum value in arcsec [ min(poslit)-delta/2 ] ; ; ymax maximum value in arcsec [ max(poslit)-delta/2 ] ; ; ; ; called by ARR_DEF ; ; INT_PLT ; ; MN2_PLT ; ; MN1_PLT ; ; ; ; Revision : Aug 22 1996 ; ; Revision : Apr 11 1997 ; ; Last Revision : Apr 24 1997 change ws.k.tdim(0,0) on ws.k.tdim_dd ; ; ; ; Silvio Giordano ; ;-----------------------------------------------------------------------; pro POS_SLIT,ws,poslit,ymin,ymax ; poslit = ws.k.trval(0,0)+ws.k.tdelt(0,0)*indgen(ws.k.tdim_dd) ymin = poslit(0) - ws.k.tdelt(0,0)/2. ymax = poslit(ws.k.tdim_dd-1) + ws.k.tdelt(0,0)/2. ; return end ; ; pro POS_SLIT_IMG, ws, y_img, ymin_img, ymax_img poslit=ws.k.trval(0,0)+ws.k.tdelt(0,0)*indgen(ws.k.tdim(0,0)) ymin=poslit(0) - ws.k.tdelt(0,0)/2. ymax=poslit(ws.k.tdim(0,0)-1) + ws.k.tdelt(0,0)/2. d=ws.k.colwdth/ws.k.arc_r y_img=ymin+d/2.+d*indgen(ws.k.nrow_img) ymin_img=min(y_img) ymax_img=max(y_img) ; return end ; ; pro POS_RSUN_IMG, ws, x_img, xmin_img, xmax_img, rmax d=ws.k.colwdth xmin=ws.k.mirangls(0) - ws.k.wdth(0)/2. rmax=max(ws.k.mirangls + ws.k.wdth/2.) x_img=xmin+d/2.+d*indgen(ws.k.ncol_img) xmin_img=min(x_img) xmax_img=max(x_img) return end ;----------------------------------------------------------------------; ; Procedure EXP_NOEXP ; ; Compute array of exposures and non-exposures widths (ARR_DEF) ; ; and introduce zeroes between exposures (IM_DSCR) ; ; ; ; Inputs : ws (ARR_DEF) ; ; dataexp (IM_DSCR) ; ; ; ; Outputs: exp_zeri_wdth (ARR_DEF) ; ; idatads (IM_DSCR) ; ; ; ; called by ARR_DEF ; ; IM_DSCR ; ;----------------------------------------------------------------------; ; pro EXP_NOEXP, ws, exp_zeri_wdth, dataexp, idatads ; non-exposure widths [solar radii] noe_wdth=ws.k.noe_wdth(0:ws.k.expcount-2) ; ; exposures and non-exposures widths [solar radii] a=where(noe_wdth le ws.k.colwdth, count) dim=(2*ws.k.expcount - 1) - count exp_zeri_wdth = fltarr(dim) if n_params() eq 2 then begin ; (ARR_DEF) ; ; calculate the values of exp_zeri_wdth n=0 for i=0, ws.k.expcount - 1 do begin if i eq 0 then begin exp_zeri_wdth(n)= ws.k.wdth(i) endif else begin if ws.k.noe_wdth(i-1) le ws.k.colwdth then begin print, 'contiguous!' exp_zeri_wdth(n)= ws.k.wdth(i) endif else begin exp_zeri_wdth(n)= noe_wdth(i-1) n= n + 1 exp_zeri_wdth(n)= ws.k.wdth(i) endelse endelse n= n + 1 endfor endif else begin ; (IM_DSCR) ; ; introduce zeroes between exposures ; then calculate idatatot = array di expos+non-expos ; and calculate the values of exp_zeri_wdth ; N.B. ; questa introduzione di zeri non va bene per i momenti !! ; zeri = transpose(fltarr(ws.k.tdim(0,0))) ; non-expos datatemp = transpose(dataexp) n=0 for i=0, ws.k.expcount - 1 do begin if i eq 0 then begin idatads=datatemp(i,*) exp_zeri_wdth(n)= ws.k.wdth(i) endif else begin idatacol=datatemp(i,*) if noe_wdth(i-1) le ws.k.colwdth then begin print, 'contiguous!' idatads=[idatads,idatacol] exp_zeri_wdth(n)= ws.k.wdth(i) endif else begin idatads=[idatads,zeri,idatacol] exp_zeri_wdth(n)= noe_wdth(i-1) n= n + 1 exp_zeri_wdth(n)= ws.k.wdth(i) endelse endelse n= n + 1 endfor idatads = transpose(idatads) endelse return end ;-----------------------------------------------------------------------; ; Procedure IM_INT ; ; Compute Intensity for each Image ; ; ; ; Option: A - intensity [ph/(cm^2 s sr)] from rad cal data ; ; B - counts/(exptime/mir_area/sltwdth)*1.e+04 ; ; from wav cal data ; ; C - counts for Ratio Images from wav cal data ; ; ; ; Inputs : ws,wsb ; ; data_img ; ; im image index ; ; tdim_int ; ; ; ; Outputs: dataexp ; ; ; ; called by IM_COMP ; ; ; ; calls Procedure : EX_SRT ; ; INT_ERR ; ; ; ; Last Revision : Mar 31 1998 error bug in Option B ; ; error computation in Option A ; ; Last Revision : Apr 24 1998 new error computation ; ; ; ; Silvio Giordano ; ;-----------------------------------------------------------------------; pro IM_INT,ws,wsb,tdim_int,data_img,dataexp,im,errexp ; ; Option: B if ws.k.int_typ(0) eq 'cnt' AND ws.k.pan1(im) eq -1 then begin tmp_fact=1.e+04 print,'image of counts/(exptime*mir_area*slit) * '+STRCOMPRESS(tmp_fact,/REM) mir_area=fltarr(wsb.k.expcount) m_ref=18162 & o_ref=41109 cm1=2 & cm2=2.951343E-04 & cm3=3.4267633E-10 co1=5 & co2=-3.521082E-03 & co3=-1.576831E-09 data_rad=data_img for k=0, wsb.k.expcount-1 do begin mir_area(k)=co1+co2*(wsb.f(k).occpos-o_ref)+co3*(wsb.f(k).occpos-o_ref)^2 rad_fact=wsb.f(k).exptime*mir_area(k)*wsb.f(k).sltwdth data_rad(*,*,k)=data_img(*,*,k)/rad_fact INT_ERR,ws,wsb,tdim_int,data_img,im,k,errexp errexp(*,k)=errexp(*,k)/rad_fact * tmp_fact endfor dataexp=total(data_rad,2)*tmp_fact endif ; Option: C (Ratio Image) if ws.k.int_typ(0) eq 'cnt' AND ws.k.pan1(im) ne -1 then begin print,'image of counts for ratio' ; intensity [counts] dataexp=total(data_img,2) ; intensity error for k=0, wsb.k.expcount-1 do INT_ERR,ws,wsb,tdim_int,data_img,im,k,errexp endif ; Option: A if ws.k.int_typ(0) ne 'cnt' AND ws.k.pan1(im) eq -1 then begin print,'image of intensity [ph/(cm^2 s sr)]' dw=ws.k.tdelt(1,im)*ws.k.wdelt(im) ; intensity [ph/(cm^2 s sr)] dataexp=total(data_img,2)*dw ; intensity error for k=0,wsb.k.expcount-1 do INT_ERR,ws,wsb,tdim_int,data_img,im,k,errexp endif ; EX_SRT,ws,wsb,dataexp return end ; ; ;----------------------------------------------------------------------; ; Procedure IM_MN1 ; ; Compute First Moment for each Image ; ; 1st Moment > 0 <---> red shift ( > l_ref) ; ; < 0 <---> blue shift ( < l_ref) ; ; Inputs : ws, wsb, ; ; ; ; Outputs: ws ; ; ; ; called by IM2_MK_IMAG ; ; ; ; calls Procedures : ; ; LAMBDA ---> lmbd ; ; ; ; ARR_DEF ---> ws.k.nrow_img ,ws.k.ncol_img ; ; ; ; IM_INT ---> dataexp = fltarr(tdim(0,0), expcount) ; ; IM_MN1 ; ; IM_MN2 ; ; IM_MN3 ; ; ; ; IM_DSCR --> idata = fltarr(ws.k.nrow_img,ws.k.ncol_img) ; ; IM_INTERP ; ; ; ; Last Revision : Feb 12 1997 ; ;----------------------------------------------------------------------; ; pro IM_MN1,ws,wsb,wav_sel,data_img,dataexp,im,errexp dataexp=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) w_av=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) s_wav=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) s_mn1=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) ;Read Reference Wavelength for Spectral Line from files lines_det.dat det=ws.k.detector NMN_RD, det, sp_line, wl_line line_sel=where(wl_line ge min(wav_sel) and wl_line le max(wav_sel), count) if count ne 1 then begin print, 'not good data for first moment computation' goto, via endif else l_ref=wl_line(line_sel) print, 'Reference Wavelength', l_ref wdiff=wav_sel-l_ref(0) ; ; Loop over exposures ; for i=0, wsb.k.expcount-1 do begin ; ; Loop over rows ; for r=0, wsb.k.tdim(0,0)-1 do begin iwl=data_img(r,*,i) num=float(total(wdiff*iwl)) den=total(iwl) if den eq 0 then den=1 dataexp(r,i)=num/den if wsb.k.status NE 'sp_rad' then begin ; ; compute average wavelength error (s_wav) ; s_int=0 if n_elements(wsb.b) eq 1 then goto,sjump s_int=SQRT(iwl + wsb.b(r,i) + wsb.b(r,i)/wsb.k.tdim_bck) sjump: a=total(iwl) b=total(wav_sel*iwl) c=((wav_sel*a-b)^2)*(s_int)^2 s_wav(r,i)=SQRT(total(c)/a^4) endif endfor endfor errexp=s_wav EX_SRT, ws, wsb, dataexp via: return end ;-----------------------------------------------------------------------; ; Procedure IM_MN2 ; ; Compute Second Order Moment and Error if data are nor Rad Cal ; ; ; ; Inputs : ws ; ; wsb ; ; wav_sel ; ; data_img ; ; ; ; Outputs: dataexp ; ; errexp ; ; ; ; called by IM_COMP ; ; ; ; calls Procedures : ; ; EX_SRT ; ; ; ; Revision : Feb 12 1997 ; ; Last Revision : Feb 24 1998 ; ; ; ; Silvio Giordano ; ;-----------------------------------------------------------------------; pro IM_MN2,ws,wsb,wav_sel,data_img,dataexp,im,errexp ; dataexp=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) errexp=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) w_av=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) s_wav=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) ; ; Loop over exposures ; for i=0, wsb.k.expcount-1 do begin ; ; Loop over rows ; for r=0, wsb.k.tdim(0,0)-1 do begin ; ; compute average wavelength (w_av) ; iwl=data_img(r,*,i) num=total(wav_sel*iwl) den=total(iwl) if den eq 0 then den=1 w_av(r,i)=num/den ; if wsb.k.status NE 'sp_rad' then begin ; ; compute average wavelength error (s_wav) ; s_int=0 if n_elements(wsb.b) eq 1 then goto,sjump s_int=SQRT(iwl + wsb.b(r,i) + wsb.b(r,i)/wsb.k.tdim_bck) sjump: a=total(iwl) b=total(wav_sel*iwl) c=((wav_sel*a-b)^2)*(s_int)^2 s_wav(r,i)=SQRT(total(c)/a^4) endif ; ; compute 2nd order moment ; wdiff=(wav_sel-w_av(r,i))^2 num=total(wdiff*iwl) dataexp(r,i)=num/den ; if wsb.k.status NE 'sp_rad' then begin ; ; compute 2nd order moment error (errexp) ; a=total(iwl) b=(wav_sel-w_av(r,i))^2 c=total(iwl*(wav_sel-w_av(r,i))^2) d=total(iwl*(wav_sel-w_av(r,i))) f=total(((b-c)/(a^2))^2*(s_int)^2) g=((-2*d/a)^2)*(s_wav(r,i))^2 errexp(r,i)=SQRT(f+g) endif endfor endfor EX_SRT, ws, wsb, dataexp return end ;----------------------------------------------------------------------; ; Procedure IM_MN3 ; ; Compute Third Order Moment for each Image ; ;----------------------------------------------------------------------; ; pro IM_MN3, ws, wsb, wav_sel, data_img, dataexp, im dataexp=fltarr(wsb.k.tdim(0,0), wsb.k.expcount) ; ; Loop over exposures ; for i=0, wsb.k.expcount-1 do begin ; ; Loop over rows ; for r=0, wsb.k.tdim(0,0)-1 do begin ; ; compute average wavelength (w_av) ; iwl=data_img(r,*,i) num=total(wav_sel*iwl) den=total(iwl) if den eq 0 then den=1 w_av=num/den ; ; compute 3th order moment ; wdiff=(wav_sel-w_av)^3 num=total(wdiff*iwl) dataexp(r,i)=num/den endfor endfor EX_SRT, ws, wsb, dataexp return end ;----------------------------------------------------------------------; ; Procedure EX_SRT ; ; Sort Data Exposures in Solar Radii increasing order ; ; ; ; Inputs : dataexp ; ; wsb ; ; ; ; Outputs: dataexp ; ; ; ; called by IM_INT ; ; ; ; ; ;----------------------------------------------------------------------; pro EX_SRT, ws, wsb, dataexp ; ord = SORT(wsb.f.cmdmir) ;DP 01 dataexp = dataexp(*,ord) return end ;-------------------------------------------------------------------------; ; Procedure IM_DSCR ; ; Build Discrete Coronal Image ; ; ; ; introduce a column of zeroes between two exposures (no attiguous) ; ; extend data array to number of columns related to slit width ; ; (= observed coronal region) ; ; ; ; Inputs : ws, wsb, dataexp (dataexp="collected" exposures) ; ; ; ; Outputs: idata (discrete image) ; ; ; ; Called by IM_COMP ; ; ; ; Calls Procedure EXP_NOEXP ; ; ; ; Calls Function C_R_REPL ; ;-------------------------------------------------------------------------; pro IM_DSCR, ws, wsb, dataexp, idata ; EXP_NOEXP, ws, exp_zeri_wdth, dataexp, idatads ; ; calculate # of columns for each exposures and non-exposures colimg=fix((exp_zeri_wdth/ws.k.colwdth)+0.5) ; ; calculate # of rows rowact=fix(((wsb.k.tdelt(0,0)*ws.k.arc_r)/ws.k.colwdth)+0.5) rowimg=rowact for i=0, wsb.k.tdim(0,0)-2 do rowimg=[rowimg,rowact] ; ; extend every row and column of idatatot idata=C_R_REPL(idatads,rowimg,colimg) ; return end ;----------------------------------------------------------------------- ; Procedure IM_INTERP ; Linear Image Interpolation ; ; Input: ws, wsb, dataexp (dataexp="collected" exposures) ; ; Output: idata (linear interpolated image) ; ; called by IM_COMP ; ; calls function C_R_REPL ; ; Purpose: ; Linear Image Interpolation ; ; Author: ; Silvio Giordano (SG) ; ; History: ; 1995 ?? (SG) ; May 27 1999 comments (SG) ; Dec 28 2001 update to DAS33 DP 01 ; Jan 23 2002 consistency with DAS33: cmdmir used below 1.74_R ; Mar 20 2002 fix bug in if MIN(wsb.f.cmdmir) ge 1.74 ; Jun 19 2002 re-introduce mirangl below 1.74 R because of my ; correction in configuration calibration ; Aug 08 2002 makes images with mirangls lower than 0. ; Oct 23 2004 finally use mirangl because new pointing calibration DAS34 ;----------------------------------------------------------------------- pro IM_INTERP, ws, wsb, dataexp, idata ; rmin=min(wsb.f.mirangl, mn) - (wsb.f(mn).sltwdth*(ws.k.mm_r)/2.) ; mirang=ws.k.mirangls(0:ws.k.expcount-1) col_r=(mirang-rmin)/(ws.k.colwdth) ; ; Compute coefficients for linear interpolation coeff = fltarr(wsb.k.tdim(0,0),ws.k.expcount-1) for i=0, ws.k.expcount-2 do $ coeff(*,i)=(dataexp(*,i+1)-dataexp(*,i))/(col_r(i+1)-col_r(i)) datatmp=fltarr(wsb.k.tdim(0,0), ws.k.ncol_img) ; ; loop over rows ; for r=0, wsb.k.tdim(0,0)-1 do begin c=indgen(ws.k.ncol_img) index = where(c lt col_r(1), count) if count ne 0 then $ datatmp(r,index) = dataexp(r,0) + coeff(r,0) * (index-col_r(0)) for i=2, ws.k.expcount-1 do begin index = where(c ge col_r(i-1) and c lt col_r(i), count) if count ne 0 then $ datatmp(r,index) = dataexp(r,i-1) + coeff(r,i-1) * (index-col_r(i-1)) endfor index = where(c ge col_r(ws.k.expcount-1), count) if count ne 0 then $ datatmp(r,index) = dataexp(r,ws.k.expcount-1) + $ coeff(r,ws.k.expcount-2) * (index-col_r(ws.k.expcount-1)) endfor ; ; calculate # of rows rowact=fix(((wsb.k.tdelt(0,0)*ws.k.arc_r)/ws.k.colwdth)+0.5) rowimg=rowact for i=0, wsb.k.tdim(0,0)-2 do rowimg=[rowimg,rowact] ; idata=C_R_REPL(datatmp,rowimg,0) return end ; ;-------------------------------------------------------------------------; ; Procedure IM_DRAW_IMA ; ; Show Images of Coronal Scans (Extension) ; ; ; ; called by IMA_DISP ; ; Defines Value of Keyword ws.k.rminpx (in POS_IMG Procedure) ; ; ws.k.yminpx ; ; calls POS_IMG ; ; SUN_DISK ; ; ROLL_DISP ; ; ; ; July 28 96: included Procedure IM_DRAW_CONT ; ; Show Contour Plots of Coronal Scans Images ; ; ; ; Jun 04 2002 Correct image position bug (first) ; (not negligible for slit collapsed images) ; called by IMA_DISP_EVENT ; ;-------------------------------------------------------------------------; pro IM_DRAW_IMA,ws ; ima=ws.k.nima wset,ws.k.win_ima idata=ws.d(*,*,ima) if ws.k.rad_fil ne 0 then begin rad_flt = fltarr(ws.k.nrow_img,ws.k.ncol_img) POS_SLIT_IMG, ws, y_img POS_RSUN_IMG, ws, x_img for i=0,n_elements(x_img)-1 do begin ny_r_arr=y_img*ws.k.arc_r rad_flt(*,i)=SQRT(x_img(i)^2 + ny_r_arr^2) endfor idata=idata*(rad_flt)^ws.k.rad_fil endif if ws.k.smt_fil eq 1 then begin q=size(idata) sub=fltarr(q(1),q(2)) box=60 fact=1.8 for i=0,q(2)-1 do begin sub1=SMOOTH(idata(*,i),box,/edge_truncate) sub(*,i)=idata(*,i)-sub1/fact endfor idata=sub endif if ws.k.log_fil eq 1 then begin idata=idata > 1 idata=alog10(idata) endif if ws.k.smooth ne 0 then begin idata=SMOOTH(idata,ws.k.smooth,/edge_truncate) endif ; define position for data image (no zero columns added) POS_IMG, ws, lst_col ; Background white !P.BACKGROUND=255 erase ; Sun disk SUN_DISK, ws, sun, size ; ; Display Contour Data Image ; if ws.k.cont_lev ne 0 then begin col=ws.k.rminpx+ws.k.ncol_img-1 row=ws.k.yminpx+ws.k.nrow_img-1 idata=rotate(idata,3) !X.STYLE=5 & !Y.STYLE=5 !P.TITLE='' & !P.MULTI=0 contour, idata, position=[ws.k.rminpx, ws.k.yminpx, col, row], /device, $ /fill, /closed, nlevels=ws.k.cont_lev, /follow contour, idata, position=[ws.k.rminpx, ws.k.yminpx, col, row], /device, $ /closed, nlevels=ws.k.cont_lev, /follow, /overplot !X.STYLE=1 & !Y.STYLE=1 endif ; ; Display Black Sun first=ws.k.trval(0,0)-(ws.k.tdelt(0,0))/2. ; SG 07/13/01 sun_c = (ws.k.nrow_img-1)+5 + (first*ws.k.arc_r)/ws.k.colwdth xsun=5 tv,sun,xsun,sun_c-size/2.+ws.k.yminpx-5 ; ; Display Data Image ; if ws.k.cont_lev eq 0 then begin tvscl,rotate(idata,3),ws.k.rminpx, ws.k.yminpx endif ; ROLL_DISP, ws, plt_fit end ; ; ;-------------------------------------------------------------------------; ; Procedure POS_IMG ; ; Define Position of Image Data Array ; ; ; ; called by IM_DRAW_IMA and others ... ; ; Defines Value of Keyword ws.k.rminpx ; ; ws.k.yminpx ; ;-------------------------------------------------------------------------; pro POS_IMG, ws, lst_col rmin=ws.k.mirangls(0) - ws.k.wdth(0)/2. ws.k.rminpx=fix(rmin/ws.k.colwdth+0.5)+5 ; +5 for bck ;ws.k.yminpx=ws.k.rowfrst+5 ; along slit 360 pixels +5 for bck ;ws.k.yminpx=(ws.k.trval(0,0)*ws.k.arc_r)/ws.k.colwdth + 180+5 ws.k.yminpx=5 rmax=max(ws.k.mirangls, mx) + (ws.k.wdth(mx)/2.) lst_col=fix(rmax/ws.k.colwdth+0.5)-1 return end pro SUN_DISK, ws, sun, size ; Sun disk ; input: ws.k.colwdth n=2 size=round(n/ws.k.colwdth) r=(shift(dist(size)*n/(size/sqrt(2)),size/2.,size/2.))^2 temp=r(size/2:*, *) index0=where(temp le 2.) index1=where(temp gt 2.) if (size/2. eq size/2) then begin sun=bytarr(size/2+1-1,size) endif else begin sun=bytarr(size/2+1,size) endelse sun(index0)=0 sun(index1)=255 return end ; ;------------------------------------------------------------------------; ; Procedure PLT_MN_Y ; ; Plot for Moments for selected Position Along Slit ; ; ; ; called by IMA_DRAW_Y ; ;------------------------------------------------------------------------; pro PLT_MN_Y, ws, x, data, data_plt ; if strcompress(ws.k.ipol(ws.k.nima),/remove_all) eq "NO" then begin plot, x, data, /NODATA for j=0,ws.k.expcount-1 do $ PLOTS, [ws.k.mirangls(j),ws.k.mirangls(j)],[!y.crange(0),data_plt(j)] endif ; ipol=strcompress(ws.k.ipol(ws.k.nima),/remove_all) if ipol eq "YES" then plot, x, data, psym=10 ; oplot, ws.k.mirangls, data_plt, psym=4 return end ;------------------------------------------------------------------------; ; Procedure IM_DRAW_Y ; ; Display histograms of Image for selected Position Along Slit ; ; ; ; called by IMA_DRAW_PLT ; ; or directly by IMA_DISP_EVENT for Hardcopy ; ;------------------------------------------------------------------------; pro IM_DRAW_Y,ws ; pos=string(ws.k.ny_arc,format='(I5)') data=ws.d(ws.k.nrow_img-1-ws.k.ny,*,ws.k.nima) if ws.k.smooth ne 0 then begin data=SMOOTH(data,ws.k.smooth,/edge_truncate) endif ;print,'TBV 2' rmin=ws.k.mirangls(0) - ws.k.wdth(0)/2. x=rmin+ws.k.colwdth*indgen(ws.k.ncol_img) ipol=strcompress(ws.k.ipol(ws.k.nima),/remove_all) if ipol eq "NO" and ws.k.wdth(ws.k.expcount-1) lt 2*ws.k.colwdth then begin index=where(data ne 0) data_plt=data(index) endif else begin data_plt=fltarr(ws.k.expcount) for j=0,ws.k.expcount-1 do begin temp=ABS(x-ws.k.mirangls(j)) a=min(temp,index) data_plt(j)=data(index) endfor endelse !x.title='Distance (Solar Radii)' !X.STYLE=2 & !Y.STYLE=2 wmtit=strcompress(ws.k.wmin(ws.k.nima),/rem)+' - '$ +strcompress(ws.k.wmax(ws.k.nima),/rem)+' '+STRING("305B) case strcompress(ws.k.ttype(ws.k.nima),/remove_all) of "INT" : begin mtitle=wmtit+' Intensity @ '+pos+'"' !mtitle=mtitle !ytitle='Intensity [ph/(s*cm^2*sterad)]' if ipol eq "NO" then plot, x, data, /NODATA if ipol eq "YES" then plot, x, data, psym=10 for j=0,ws.k.expcount-1 do $ PLOTS, [ws.k.mirangls(j),ws.k.mirangls(j)], [0,data_plt(j)] end "MN1" : begin mtitle=wmtit+' Doppler-gram @ '+pos+'"' !mtitle=mtitle !ytitle='[Angstrom]' PLT_MN_Y, ws, x, data, data_plt end "MN2" : begin mtitle=wmtit+' Width @ '+pos+'"' !mtitle=mtitle !ytitle='[Angstrom^2]' PLT_MN_Y, ws, x, data, data_plt end "MN3" : begin mtitle=wmtit+' Symmetry @ '+pos+'"' !mtitle=mtitle !ytitle='[Angstrom^3]' PLT_MN_Y, ws, x, data, data_plt end endcase plots,[ws.k.nx_r,ws.k.nx_r],[!y.crange(0),!y.crange(1)],linestyle=2 return end ; ;------------------------------------------------------------------------; ; Procedure IM_DRAW_X ; ; Display histograms of Image for selected Solar Radii Distance ; ; ; ; called by IMA_DRAW_PLT ; ; or directly by IMA_DISP_EVENT for Hardcopy ; ;------------------------------------------------------------------------; pro IM_DRAW_X,ws ; dis=string(ws.k.nx_r,format='(G5.3)') data=ws.d(*,ws.k.nx,ws.k.nima) if ws.k.smooth ne 0 then begin data=SMOOTH(data,ws.k.smooth,/edge_truncate) endif ;print,'TBV 1' y=ws.k.trval(0,0)-ws.k.tdelt(0,0) + $ (ws.k.colwdth*indgen(ws.k.nrow_img))/ws.k.arc_r !x.title='Slit Position (arcsec)' !X.STYLE=2 & !Y.STYLE=2 wmtit=strcompress(ws.k.wmin(ws.k.nima),/rem)+' - '$ +strcompress(ws.k.wmax(ws.k.nima),/rem)+' '+STRING("305B) case strcompress(ws.k.ttype(ws.k.nima),/remove_all) of "INT" : begin mtitle=wmtit+' Intensity @ '+dis+' R!9!Dn!3' !mtitle=mtitle !ytitle='Intensity [ph/(s*cm^2*sterad)]' end "MN1" : begin mtitle=wmtit+' Doppler-gram @ '+dis+' R!9!Dn!3' !mtitle=mtitle !ytitle='[Angstrom]' end "MN2" : begin mtitle=wmtit+' Width @ '+dis+' R!9!Dn!3' !mtitle=mtitle !ytitle='[Angstrom^2]' end "MN3" : begin mtitle=wmtit+' Symmetry @ '+dis+' R!9!Dn!3' !mtitle=mtitle !ytitle='[Angstrom^3]' end endcase plot,y,data, psym=10 plots,[ws.k.ny_arc,ws.k.ny_arc],[!y.crange(0),!y.crange(1)],linestyle=2 return end ; ;------------------------------------------------------------------------; ; Procedure IM_DRAW_PLT ; ; Display histograms of Image in scrolling window ; ; ; ; called by IMA_DISP ; ; IMA_DISP_EVENT ; ; ; ; calls IM_DRAW_Y ; ; IM_DRAW_X ; ;------------------------------------------------------------------------; pro IM_DRAW_PLT,ws set_plot,'x' wset,ws.k.win_plt !P.MULTI=[0,0,2,0,0] IM_DRAW_Y,ws IM_DRAW_X,ws !X.STYLE=0 & !Y.STYLE=0 end ;----------------------------------------------------------------------; ; Procedure SYN_SEL ; ; Load from the data sets the single images to build synoptic ; ; ; ; Inputs : common das (ws#) ; ; j synoptic image index ; ; ds single scan image index ; ; ; ; Outputs: mirangls ; ; wdth ; ; wsd ; ; angle ; ; x0_arc ; ; ; ; called by IMA_MK_SYNOPT ; ; ; ; calls Procedure : ; ; POS_SLIT ---> ymin (for image offset) ; ;----------------------------------------------------------------------; ; pro SYN_SEL, j, ds, mirangls, wdth, wsd, angle, x0_arc common das,ws0,ws1,ws2,ws3,ws4,ws5,ws6,ws7,ws8,ws9 case ds of 0: begin mirangls=ws0.k.mirangls wdth=ws0.k.wdth wsd=ws0.d(*,*,j) angle=ws0.k.angle POS_SLIT,ws0,poslit,ymin,ymax x0_arc=ymin end 1: begin mirangls=ws1.k.mirangls wdth=ws1.k.wdth wsd=ws1.d(*,*,j) angle=ws1.k.angle POS_SLIT,ws1,poslit,ymin,ymax x0_arc=ymin end 2: begin mirangls=ws2.k.mirangls wdth=ws2.k.wdth wsd=ws2.d(*,*,j) angle=ws2.k.angle POS_SLIT,ws2,poslit,ymin,ymax x0_arc=ymin end 3: begin mirangls=ws3.k.mirangls wdth=ws3.k.wdth wsd=ws3.d(*,*,j) angle=ws3.k.angle POS_SLIT,ws3,poslit,ymin,ymax x0_arc=ymin end 4: begin mirangls=ws4.k.mirangls wdth=ws4.k.wdth wsd=ws4.d(*,*,j) angle=ws4.k.angle POS_SLIT,ws4,poslit,ymin,ymax x0_arc=ymin end 5: begin mirangls=ws5.k.mirangls wdth=ws5.k.wdth wsd=ws5.d(*,*,j) angle=ws5.k.angle POS_SLIT,ws5,poslit,ymin,ymax x0_arc=ymin end 6: begin mirangls=ws6.k.mirangls wdth=ws6.k.wdth wsd=ws6.d(*,*,j) angle=ws6.k.angle POS_SLIT,ws6,poslit,ymin,ymax x0_arc=ymin end 7: begin mirangls=ws7.k.mirangls wdth=ws7.k.wdth wsd=ws7.d(*,*,j) angle=ws7.k.angle POS_SLIT,ws7,poslit,ymin,ymax x0_arc=ymin end 8: begin mirangls=ws8.k.mirangls wdth=ws8.k.wdth wsd=ws8.d(*,*,j) angle=ws8.k.angle POS_SLIT,ws8,poslit,ymin,ymax x0_arc=ymin end 9: begin mirangls=ws9.k.mirangls wdth=ws9.k.wdth wsd=ws9.d(*,*,j) angle=ws9.k.angle POS_SLIT,ws9,poslit,ymin,ymax x0_arc=ymin end endcase return end ;----------------------------------------------------------------------; ; Procedure ARR_DEF_SYN ; ; Define Image Array Dimension for Synoptic Image ; ; ; ; Inputs : common das (ws#) ; ; ; ; Outputs: index (index of the data set input for a synoptic image) ; ; nscans (number of coronal scans) ; ; siz (# of pixels of the synoptic image) ; ; ; ; Called by IMA_MK_SYNOPT ; ;----------------------------------------------------------------------; pro ARR_DEF_SYN, siz, nscans, index ; common das,ws0,ws1,ws2,ws3,ws4,ws5,ws6,ws7,ws8,ws9 status=[ws0.k.status,ws1.k.status,ws2.k.status,ws3.k.status,ws4.k.status, $ ws5.k.status,ws6.k.status,ws7.k.status,ws8.k.status,ws9.k.status] index=where(status eq 'im_mir', nscans) detect=[ws0.k.detector,ws1.k.detector,ws2.k.detector,ws3.k.detector, $ ws4.k.detector,ws5.k.detector,ws6.k.detector,ws7.k.detector, $ ws8.k.detector,ws9.k.detector] det=detect(index(0)) index=where(status eq 'im_mir' and detect eq det, nscans) t=fltarr(10) if status(0) eq 'im_mir' and ws0.k.detector eq det then begin t(0)=max(ws0.k.mirangls+ws0.k.wdth/2.) colwdth=ws0.k.colwdth endif if status(1) eq 'im_mir' and ws1.k.detector eq det then begin t(1)=max(ws1.k.mirangls+ws1.k.wdth/2.) colwdth=ws1.k.colwdth endif if status(2) eq 'im_mir' and ws2.k.detector eq det then begin t(2)=max(ws2.k.mirangls+ws2.k.wdth/2.) colwdth=ws2.k.colwdth endif if status(3) eq 'im_mir' and ws3.k.detector eq det then begin t(3)=max(ws3.k.mirangls+ws3.k.wdth/2.) colwdth=ws3.k.colwdth endif if status(4) eq 'im_mir' and ws4.k.detector eq det then begin t(4)=max(ws4.k.mirangls+ws4.k.wdth/2.) colwdth=ws4.k.colwdth endif if status(5) eq 'im_mir' and ws5.k.detector eq det then begin t(5)=max(ws5.k.mirangls+ws5.k.wdth/2.) colwdth=ws5.k.colwdth endif if status(6) eq 'im_mir' and ws6.k.detector eq det then begin t(6)=max(ws6.k.mirangls+ws6.k.wdth/2.) colwdth=ws6.k.colwdth endif if status(7) eq 'im_mir' and ws7.k.detector eq det then begin t(7)=max(ws7.k.mirangls+ws7.k.wdth/2.) colwdth=ws7.k.colwdth endif if status(8) eq 'im_mir' and ws8.k.detector eq det then begin t(8)=max(ws8.k.mirangls+ws8.k.wdth/2.) colwdth=ws8.k.colwdth endif if status(9) eq 'im_mir' and ws9.k.detector eq det then begin t(9)=max(ws9.k.mirangls+ws9.k.wdth/2.) colwdth=ws9.k.colwdth endif ;print, 'Number of coronal scans:', nscans ;print, 'Synoptic Image built from:' ;for f=0,nscans-1 do begin ; print, $ ;' Data Set n.',strcompress(index(f)),' - ', detect(index(f)), ' image' ;endfor mx=max(t) siz=2*fix(mx/colwdth+0.5)+70 siz=siz/2 return end ;----------------------------------------------------------------------; ; Procedure IMA_MK_SYNOPT ; ; Compute Synoptic Images from builded Scan Images ; ; ; ; Inputs : common das (ws#) ; ; ; ; Outputs: ws ; ; ; ; called by "Make Synoptic" button ; ; ; ; calls Procedures : ; ; ARR_DEF_SYN ---> siz,nscans,index ; ; KEY_DEF_SYN ---> ws.k..... ; ; ; ; SYN_SEL ; ;----------------------------------------------------------------------; ; pro IMA_MK_SYNOPT, ws,stat,path,file common das,ws0,ws1,ws2,ws3,ws4,ws5,ws6,ws7,ws8,ws9 status=[ws0.k.status,ws1.k.status,ws2.k.status,ws3.k.status,ws4.k.status, $ ws5.k.status,ws6.k.status,ws7.k.status,ws8.k.status,ws9.k.status] a=where(status eq 'im_mir', cnt) if cnt eq 0 then begin POP_UP,'Error','Data Sets not ready to build Synoptic' return endif indx=ws.k.index skey={SKEY} widgs={WIDGS, sy_draw_ima: 0l} ws={k: skey, d: 0, w:widgs} ws.k.index=indx ws.k.origin='UNITO' ws.k.status='im_syn' print, '*********** Start Synoptic Images Building *********** ' ; ;Definition of Synoptic Array ; ARR_DEF_SYN,siz,nscans,index ws.k.siz=siz ws.k.nscans=nscans ws.k.nrow_img=siz ws.k.ncol_img=siz KEY_DEF_SYN,ws,index ; Define Synoptic Array Data data = fltarr(siz, siz, ws.k.nimage) ; ; Loop over images ; for j=0, ws.k.nimage-1 do begin ; ;Define Temporary Array den=fltarr(siz,siz) ; Define Array Sum of the Single Scans syn=fltarr(siz,siz) ; ; Loop over coronal scans ; for i=0, nscans-1 do begin ds=index(i) ; ; Load single scan ; SYN_SEL, j, ds, mirangls, wdth, wsd, angle, x0_arc q=size(wsd) nrow_img=ROUND(q(1)/2.) ncol_img=ROUND(q(2)/2.) wsd=CONGRID(wsd,nrow_img,ncol_img) ; ; Put single scan into synoptic array (synt) ; rmin=mirangls(0) - wdth(0)/2. rmin_c=fix((rmin/ws.k.colwdth)+0.5) col=ncol_img+rmin_c exp_syn=fltarr(nrow_img, col) exp_syn(*,rmin_c:col-1)=wsd colwdth_arc=(ws.k.colwdth)/ws.k.arc_r x0=ROUND(siz/2.+(x0_arc/colwdth_arc)) x1=ROUND(x0+nrow_img-1) y0=ROUND(siz/2.-1) y1=ROUND(y0+col-1) synt=fltarr(siz,siz) ; temporary array synt(x0:x1,y0:y1)=exp_syn synt=ROT(synt,-angle,/missing) ;synt=ROT(synt,-angle,/interp) ; ; Sum data (synt) to previous Scans (syn) ; syn=syn+synt i_tem=where(synt gt 0, count2) if count2 ne 0 then den(i_tem)=den(i_tem)+1 endfor ;Average for the overlapping values den=den>1 data(*,*,j)=syn/den endfor widgs={WIDGS} ws={k: ws.k, d: data, w:widgs} print, '*********** End Synoptic Images Building *********** ' stat=ws.k.status path=ws.k.path file=ws.k.file return end ;-------------------------------------------------------------------------; ; Procedure KEY_DEF_SYN ; ; Define Some Keywords for Synoptic Structure ; ; ; ; called by IMA_MK_SYNOPT ; ;-------------------------------------------------------------------------; pro KEY_DEF_SYN,ws,index common das,ws0,ws1,ws2,ws3,ws4,ws5,ws6,ws7,ws8,ws9 case index(0) of 0: begin ws.k.colwdth=ws0.k.colwdth*2 ws.k.arc_r=ws0.k.arc_r ;ws.k.file=strmid(ws0.k.file,0,strlen(ws0.k.file)-3)+'syn' ws.k.file=strmid(ws0.k.file,0,strlen(ws0.k.file))+'syn' ws.k.nimage=ws0.k.nimage ws.k.sp_path=ws0.k.path ws.k.sp_file=ws0.k.file ws.k.detector=ws0.k.detector ws.k.wid_main=ws0.k.wid_main ws.k.ttype=ws0.k.ttype ws.k.ipol=ws0.k.ipol ws.k.int_typ=ws0.k.int_typ end 1: begin ws.k.colwdth=ws1.k.colwdth*2 ws.k.arc_r=ws1.k.arc_r ws.k.file=strmid(ws1.k.file,0,strlen(ws1.k.file))+'syn' ws.k.nimage=ws1.k.nimage ws.k.sp_path=ws1.k.path ws.k.sp_file=ws1.k.file ws.k.detector=ws1.k.detector ws.k.wid_main=ws1.k.wid_main ws.k.ttype=ws1.k.ttype ws.k.ipol=ws1.k.ipol ws.k.int_typ=ws1.k.int_typ end 2: begin ws.k.colwdth=ws2.k.colwdth*2 ws.k.arc_r=ws2.k.arc_r ws.k.file=strmid(ws2.k.file,0,strlen(ws2.k.file)-3)+'syn' ws.k.nimage=ws2.k.nimage ws.k.sp_path=ws2.k.path ws.k.sp_file=ws2.k.file ws.k.detector=ws2.k.detector ws.k.wid_main=ws2.k.wid_main ws.k.ttype=ws2.k.ttype ws.k.ipol=ws2.k.ipol ws.k.int_typ=ws2.k.int_typ end 3: begin ws.k.colwdth=ws3.k.colwdth*2 ws.k.arc_r=ws3.k.arc_r ws.k.file=strmid(ws3.k.file,0,strlen(ws3.k.file)-3)+'syn' ws.k.nimage=ws3.k.nimage ws.k.sp_path=ws3.k.path ws.k.sp_file=ws3.k.file ws.k.detector=ws3.k.detector ws.k.wid_main=ws3.k.wid_main ws.k.ttype=ws3.k.ttype ws.k.ipol=ws3.k.ipol ws.k.int_typ=ws3.k.int_typ end 4: begin ws.k.colwdth=ws4.k.colwdth*2 ws.k.arc_r=ws4.k.arc_r ws.k.file=strmid(ws4.k.file,0,strlen(ws4.k.file)-3)+'syn' ws.k.nimage=ws4.k.nimage ws.k.sp_path=ws4.k.path ws.k.sp_file=ws4.k.file ws.k.detector=ws4.k.detector ws.k.wid_main=ws4.k.wid_main ws.k.ttype=ws4.k.ttype ws.k.ipol=ws4.k.ipol ws.k.int_typ=ws4.k.int_typ end 5: begin ws.k.colwdth=ws5.k.colwdth*2 ws.k.arc_r=ws5.k.arc_r ws.k.file=strmid(ws5.k.file,0,strlen(ws5.k.file)-3)+'syn' ws.k.nimage=ws5.k.nimage ws.k.sp_path=ws5.k.path ws.k.sp_file=ws5.k.file ws.k.detector=ws5.k.detector ws.k.wid_main=ws5.k.wid_main ws.k.ttype=ws5.k.ttype ws.k.ipol=ws5.k.ipol ws.k.int_typ=ws5.k.int_typ end 6: begin ws.k.colwdth=ws6.k.colwdth*2 ws.k.arc_r=ws6.k.arc_r ws.k.file=strmid(ws6.k.file,0,strlen(ws6.k.file)-3)+'syn' ws.k.nimage=ws6.k.nimage ws.k.sp_path=ws6.k.path ws.k.sp_file=ws6.k.file ws.k.detector=ws6.k.detector ws.k.wid_main=ws6.k.wid_main ws.k.ttype=ws6.k.ttype ws.k.ipol=ws6.k.ipol ws.k.int_typ=ws6.k.int_typ end 7: begin ws.k.colwdth=ws7.k.colwdth*2 ws.k.arc_r=ws7.k.arc_r ws.k.file=strmid(ws7.k.file,0,strlen(ws7.k.file)-3)+'syn' ws.k.nimage=ws7.k.nimage ws.k.sp_path=ws7.k.path ws.k.sp_file=ws7.k.file ws.k.detector=ws7.k.detector ws.k.wid_main=ws7.k.wid_main ws.k.ttype=ws7.k.ttype ws.k.ipol=ws7.k.ipol ws.k.int_typ=ws7.k.int_typ end 8: begin ws.k.colwdth=ws8.k.colwdth*2 ws.k.arc_r=ws8.k.arc_r ws.k.file=strmid(ws8.k.file,0,strlen(ws8.k.file)-3)+'syn' ws.k.nimage=ws8.k.nimage ws.k.sp_path=ws8.k.path ws.k.sp_file=ws8.k.file ws.k.detector=ws8.k.detector ws.k.wid_main=ws8.k.wid_main ws.k.ttype=ws8.k.ttype ws.k.ipol=ws8.k.ipol ws.k.int_typ=ws8.k.int_typ end 9: begin ws.k.colwdth=ws9.k.colwdth*2 ws.k.arc_r=ws9.k.arc_r ws.k.file=strmid(ws9.k.file,0,strlen(ws9.k.file)-3)+'syn' ws.k.nimage=ws9.k.nimage ws.k.sp_path=ws9.k.path ws.k.sp_file=ws9.k.file ws.k.detector=ws9.k.detector ws.k.wid_main=ws9.k.wid_main ws.k.ttype=ws9.k.ttype ws.k.ipol=ws9.k.ipol ws.k.int_typ=ws9.k.int_typ end endcase return end ;-------------------------------------------------------------------------; ; Procedure SYN_DISP ; ; Create and Realize Synoptic Image Data Display Window ; ;-------------------------------------------------------------------------; pro SYN_DISP, ws,stat,path,file ; ; Create base widget: ; number=strcompress(ws.k.index,/remove_all) title ='Data Set nr. '+number+' -- File: '+path+file+' ('+stat+')' base =widget_base(title=title, $ xsize=ws.k.siz+25,ysize=ws.k.siz+140,xoffset=100,yoffset=90,/column) ; ; Create widget image display: ; arow=widget_base(base,/row,/frame) ; ; Draw widget size ; ws.k.xdraw=ws.k.siz + 10 ; 5 left-right edges ws.k.ydraw=ws.k.siz + 10 ; 5 pixels top-bottom edges sy_draw_ima=widget_draw(arow,/button_events,uvalue='IMAG', $ xsize=ws.k.xdraw,ysize=ws.k.ydraw) ws.w.sy_draw_ima=sy_draw_ima ; ; Create buttons and sliders for image control: ; brow=widget_base(base,/row) acol=widget_base(brow,/column) crow=widget_base(acol,/row) ; ; 1) Button to quit display: ; button=widget_button(crow,value='QUIT',uvalue='QUIT',resource_name='green') ; ; 2) Button to display pointing coordinates: ; ;;button=widget_button(crow,value='PTNG',uvalue='PTNG',resource_name='red') ; ; 3) Button for Log Filter: ; button=widget_button(crow,value='FLOG',uvalue='FLOG',resource_name='magenta') ; ; 4) Button for Contrast Enhancement (Poles): ; ;;button=widget_button(crow,value='Cntr',uvalue='Cntr',resource_name='magenta') ; ; 5) Pull-down menu for info about Image or Fits file: ; ;;about=[{MENU,1,'INFO' ,'MENU' }, $ ;; {MENU,0,'About Image' ,'INFO_SYN' }, $ ;; {MENU,0,'About Fits ' ,'INFO_SYN_FITS' }] ;;menu2=cw_pdmenu(crow,about,uvalue=about.proc) ; ; 6) Slider to select Image index: ; nimage=ws.k.nimage if nimage gt 1 then begin title ='Image ID {0 to '+strcompress(nimage-1,/remove_all)+'}' slider=widget_slider(acol,title=title,uvalue='NIMG', $ minimum=0,maximum=nimage-1) endif else begin label =widget_label(acol,value='Only one Image',/frame) endelse ; ; Realize widgets: ; widget_control,/realize,base ; ; Make Images in "draw" widgets: ; widget_control,sy_draw_ima,get_value=win_ima ws.k.win_ima=win_ima ws.k.log_fil=1 ;ws.k.smt_fil=0 SY_DRAW_IMA,ws ; ; Store "ws" structure in UVALUE of base widget: ; widget_control,base,set_uvalue=ws ; ; Register with XMANAGER: ; xmanager,'SYN_DISP',base,/just_reg end ;------------------------------------------------------------------------- ; Process Spectral Data Display Window Events ;------------------------------------------------------------------------- pro SYN_DISP_EVENT,ev ; ; Get parameters associated with the widget: ; widget_control,ev.id,get_uvalue=uvalue if strmid(uvalue(0),0,4) eq 'MENU' then uvalue=uvalue(ev.value) widget_control,ev.top,get_uvalue=ws ; ; Quit Display: ; if uvalue eq 'QUIT' then begin widget_control,ev.top,/destroy return endif ; ; Display Pointing Coordinates button: ; ;;if uvalue eq 'PTNG' then begin ;; POP_UP,'Sorry...','function not yet implemented' ;; return ;;endif ; ; Logaritmic Filter: ; if uvalue eq 'FLOG' then begin ws.k.log_fil=0 SY_DRAW_IMA,ws endif ; ;;if uvalue eq 'Cntr' then begin ;; POP_UP,'Sorry...','function not yet implemented' ;; return ;;endif ; ; Info about Present Image or Image Fits: ; ;;if strmid(uvalue,0,4) eq 'INFO' then begin ;; POP_UP,'Sorry...','function not yet implemented' ;; return ;;endif ; ; Process slider events: ; if uvalue eq 'NIMG' then begin widget_control,ev.top,/hourglass widget_control,ws.w.sy_draw_ima,get_value=win_ima ws.k.win_ima=win_ima ws.k.nima=ev.value ; Update image: ws.k.log_fil=1 SY_DRAW_IMA,ws endif ; ; Store revised "ws" in UVALUE of Display widget: ; widget_control,ev.top,set_uvalue=ws end ;-------------------------------------------------------------------------; ; Procedure SY_DRAW_IMA ; ; Show Synoptic Images ; ; ; ; called by SYN_DISP ; ;-------------------------------------------------------------------------; pro SY_DRAW_IMA,ws !p.background=255 wset,ws.k.win_ima sdata=ws.d(*,*,ws.k.nima) if ws.k.log_fil eq 1 then begin sdata=sdata > 1 sdata=alog10(sdata) endif n=1 bck=(shift(dist(ws.k.siz)*n/(ws.k.siz/sqrt(2)),ws.k.siz/2.,ws.k.siz/2.))^2 if ws.k.ipol(ws.k.nima) eq 'NO' then begin indx0=where(bck gt 0.02) indx1=where(bck le 0.02) endif if ws.k.ipol(ws.k.nima) eq 'YES' then begin bw=0.15 if ws.k.siz lt 400 then bw=bw*2.5 if ws.k.siz gt 600 then bw=0.1 indx0=where(bck gt bw) indx1=where(bck le bw) endif bck(indx0)=0 bck(indx1)=1 nozeri=where(sdata ne 0) bck(nozeri)=1 zeri=where(sdata eq 0) sdata(zeri)=max(sdata) sdata=sdata*bck ; ; Display Synoptic Image tvscl,sdata, 5, 5 ; Show Sun disk n=1 size=round((2*n)/ws.k.colwdth) sun=(shift(dist(size)*n/(size/sqrt(2)),size/2.,size/2.))^2 index0=where(sun le 0.50) index2=where(sun gt 0.50) sun(index0)=0 sun(index2)=255 pos=ws.k.siz/2.-round(1./ws.k.colwdth) tv, sun, pos+5, pos+5 return end ;---------------------------------------------------------------------- ; Write Image Data File: ;---------------------------------------------------------------------- ; pro IMA_WR_IMAG,ws,stat,path,file ; common wd_mn,wid_main ws.k.wid_main=wid_main widget_control,ws.k.wid_main,/hourglass stat1=strmid(stat,0,3) if stat1 ne 'im_' then begin POP_UP,'Error','Not an Image or Synoptic data set' return endif ; ; 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='' ext='' FILE_EXTENS,stat2,path,ext if stat2 eq 'Cancel' then return ; ; Generate new file name: ; stat1=strmid(stat,0,6) if stat1 eq 'im_mir' then typ='ima' else typ='syn' file=root+typ+ext ; ; Avoid to Overwrite Existing Fits ; spawn , 'ls '+path, list, /sh ;DP 10/00 a=where(list eq file, cnt) ans='' if cnt ne 0 then begin title='Warning' text='You Are Overwritting a Fits on '+path POP_UP_OK,title,text,ans if ans eq 'Cancel' then return endif ; ws.k.path=path ; ; Write file: ; FITS_WRITE_IMA,ws,stat,path,file end ; ; pro FITS_WRITE_IMA,ws,stat,path,file ; ; Create FITS Primary Header: ; fxhmake,primary_header,/extend,/date ; ; Write keywords for Image, Fit and Synoptic Data ; ws.k.file=file ws.k.filename=file ; fxaddpar,primary_header,'FILE',ws.k.file fxaddpar,primary_header,'PATH',ws.k.path fxaddpar,primary_header,'FILENAME',ws.k.filename fxaddpar,primary_header,'SP_PATH',ws.k.sp_path fxaddpar,primary_header,'SP_FILE',ws.k.sp_file fxaddpar,primary_header,'SP_ONUM',ws.k.sp_onum fxaddpar,primary_header,'CAL_FILE',ws.k.cal_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,'EXPCOUNT',ws.k.expcount 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 fxaddpar,primary_header,'NIMAGE',ws.k.nimage fxaddpar,primary_header,'NIMA',ws.k.nima fxaddpar,primary_header,'INT_TYP',ws.k.int_typ ; ;Write keywords for Image and Fit Data only ; if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin for n=0,ws.k.expcount-1 do begin number=strcompress(n,/remove_all) fxaddpar,primary_header,'MIRANG'+number,ws.k.mirangls(n) fxaddpar,primary_header,'WDTH'+number,ws.k.wdth(n) fxaddpar,primary_header,'EXPTIME'+number,ws.k.exptimes(n) if n ne ws.k.expcount-1 then $ fxaddpar,primary_header,'NOE_WD'+number,ws.k.noe_wdth(n) endfor endif ; ;Write keywords for Image, Fit and Synoptic Data ; for n=0,ws.k.nimage-1 do begin number=strcompress(n,/remove_all) fxaddpar,primary_header,'IPOL'+number,ws.k.ipol(n) fxaddpar,primary_header,'TTYPE'+number,ws.k.ttype(n) fxaddpar,primary_header,'WMIN'+number,ws.k.wmin(n) fxaddpar,primary_header,'WMAX'+number,ws.k.wmax(n) fxaddpar,primary_header,'DESC'+number,ws.k.desc(n) fxaddpar,primary_header,'WMIN1'+number,ws.k.wmin1(n) fxaddpar,primary_header,'WMAX1'+number,ws.k.wmax1(n) fxaddpar,primary_header,'TRCAL'+number,ws.k.trcal(n) fxaddpar,primary_header,'WDELT'+number,ws.k.wdelt(n) endfor fxaddpar,primary_header,'DETECTOR',ws.k.detector fxaddpar,primary_header,'NCOL_IMG',ws.k.ncol_img fxaddpar,primary_header,'NROW_IMG',ws.k.nrow_img fxaddpar,primary_header,'COLWDTH',ws.k.colwdth ; ;Write keywords for Image and Fit Data only ; if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin fxaddpar,primary_header,'ROWNGRP ',ws.k.rowngrp fxaddpar,primary_header,'ROWFRST ',ws.k.rowfrst fxaddpar,primary_header,'ROWACT ',ws.k.rowact fxaddpar,primary_header,'ROWSPC ',ws.k.rowspc fxaddpar,primary_header,'RMINPX', ws.k.rminpx fxaddpar,primary_header,'YMINPX', ws.k.yminpx fxaddpar,primary_header,'ANGLE', ws.k.angle fxaddpar,primary_header,'TDIM_DD', ws.k.tdim_dd fxaddpar,primary_header,'TDIM_B', 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,'ORB_FILE',ws.k.orb_file fxaddpar,primary_header,'ORB_PATH',ws.k.orb_path fxaddpar,primary_header,'TNFILE', ws.k.tnfile fxaddpar,primary_header,'DSFILE', ws.k.dsfile endif ; ;Write keywords for Image, Fit and Synoptic Data ; fxaddpar,primary_header,'MM_R',ws.k.mm_r fxaddpar,primary_header,'ARC_R',ws.k.arc_r ; if ws.k.status eq 'im_syn' then fxaddpar,primary_header,'SIZ',ws.k.siz ; ; Create Binary Table Extension header: ; ;Image and Fit Data if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then $ fxaddpar,primary_header,'EXTNAME','IMAGE' fxwrite,path+file,primary_header if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then $ fxbhmake,header,1,'IMAGE' ; ;Synoptic Data if ws.k.status eq 'im_syn' then fxaddpar,primary_header,'EXTNAME','SYNOPTIC' fxwrite,path+file,primary_header if ws.k.status eq 'im_syn' then fxbhmake,header,1,'SYNOPTIC' ; col_data=lonarr(ws.k.nimage) & col_datadd=col_data & col_dataer=col_data for n=0,ws.k.nimage-1 do begin number=strcompress(n,/remove_all) ; ;Image and Fit Data if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin tdesc=string(ws.k.tdesc(0,0),ws.k.tdesc(1,n),'("(",a,",",a,")")') trval=string(ws.k.trval(0,0),ws.k.trval(1,n),'("(",f6.0,",",f7.2,")")') tdelt=string(ws.k.tdelt(0,0),ws.k.tdelt(1,n),'("(",f6.2,",",f7.4,")")') tsize=string(ws.k.tsize(0,0),ws.k.tsize(1,n),'("(",f6.2,",",f7.4,")")') endif if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then $ data=fltarr(ws.k.nrow_img,ws.k.ncol_img) if ws.k.status eq 'im_syn' then data=fltarr(ws.k.siz,ws.k.siz) ; ;Define columns for image data: fxbaddcol,col,header,data,'DATA_IMG'+number col_data(n)=col colnum=strcompress(col,/remove_all) ;Image and Fit Data if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin fxaddpar,header,'TDESC'+colnum,tdesc fxaddpar,header,'TRVAL'+colnum,trval fxaddpar,header,'TDELT'+colnum,tdelt fxaddpar,header,'TSIZE'+colnum,tsize ;Define columns for ws.dd and ws.err data/err arrays if ws.k.tdim_dd ne 0 then begin datadd=fltarr(ws.k.tdim_dd,ws.k.expcount) & dataer=datadd fxbaddcol,coldd,header,datadd,'DATA_DD'+number col_datadd(n)=coldd fxbaddcol,coler,header,dataer,'DATA_ER'+number col_dataer(n)=coler endif endif endfor if ws.k.status eq 'im_fit' then begin ; ;Fit keywords ws.fit (Fit Data only) ; col_dist =lonarr(1) & col_theta =col_dist col_chi =lonarr(ws.k.nimage) & col_ifbin=col_chi & col_lamb=col_chi col_e_lamb =col_chi & col_sig =col_chi & col_e_sig =col_chi col_vel1e =col_chi & col_e_vel1e =col_chi & col_tk1 =col_chi col_e_tk1 =col_chi & col_peak =col_chi & col_e_peak =col_chi col_areag =col_chi & col_e_areag =col_chi & col_bck =col_chi col_e_bck =col_chi col_lamb2 =col_chi & col_e_lamb2 =col_chi col_sig2 =col_chi & col_e_sig2 =col_chi col_vel1e2 =col_chi & col_e_vel1e2=col_chi & col_tk2 =col_chi col_e_tk2 =col_chi & col_peak2 =col_chi & col_e_peak2=col_chi col_areag2 =col_chi & col_e_areag2=col_chi & col_rat12 =col_chi col_e_rat12=col_chi & col_speed =col_chi & col_tpar =col_chi col_oratio =col_dist & col_e_oratio=col_dist col_tte =col_dist & col_dde =col_dist col_speed =lonarr(6) & col_tpar =col_speed dataf=fltarr(ws.k.tdim_dd,ws.k.expcount) fxbaddcol,col,header,dataf,'DIST' & col_dist =col fxbaddcol,col,header,dataf,'THETA' & col_theta =col fxbaddcol,col,header,dataf,'ORATIO' & col_oratio =col fxbaddcol,col,header,dataf,'E_ORATIO'& col_e_oratio=col fxbaddcol,col,header,dataf,'TTE' & col_tte =col fxbaddcol,col,header,dataf,'DDE' & col_dde =col for n=0,ws.k.nimage-1 do begin number=strcompress(n,/remove_all) ; ;Define columns for Fit keywords arrays: fxbaddcol,col,header,dataf,'IFBIN' +number & col_ifbin(n) =col fxbaddcol,col,header,dataf,'CHI' +number & col_chi(n) =col fxbaddcol,col,header,dataf,'LAMB' +number & col_lamb(n) =col fxbaddcol,col,header,dataf,'E_LAMB' +number & col_e_lamb(n) =col fxbaddcol,col,header,dataf,'SIG' +number & col_sig(n) =col fxbaddcol,col,header,dataf,'E_SIG' +number & col_e_sig(n) =col fxbaddcol,col,header,dataf,'VEL1E' +number & col_vel1e(n) =col fxbaddcol,col,header,dataf,'E_VEL1E' +number & col_e_vel1e(n) =col fxbaddcol,col,header,dataf,'TK1' +number & col_tk1(n) =col fxbaddcol,col,header,dataf,'E_TK1' +number & col_e_tk1(n) =col fxbaddcol,col,header,dataf,'PEAK' +number & col_peak(n) =col fxbaddcol,col,header,dataf,'E_PEAK' +number & col_e_peak(n) =col fxbaddcol,col,header,dataf,'AREAG' +number & col_areag(n) =col fxbaddcol,col,header,dataf,'E_AREAG' +number & col_e_areag(n) =col fxbaddcol,col,header,dataf,'BCK' +number & col_bck(n) =col fxbaddcol,col,header,dataf,'E_BCK' +number & col_e_bck(n) =col fxbaddcol,col,header,dataf,'LAMB2' +number & col_lamb2(n) =col fxbaddcol,col,header,dataf,'E_LAMB2' +number & col_e_lamb2(n) =col fxbaddcol,col,header,dataf,'SIG2' +number & col_sig2(n) =col fxbaddcol,col,header,dataf,'E_SIG2' +number & col_e_sig2(n) =col fxbaddcol,col,header,dataf,'VEL1E2' +number & col_vel1e2(n) =col fxbaddcol,col,header,dataf,'E_VEL1E2'+number & col_e_vel1e2(n)=col fxbaddcol,col,header,dataf,'TK2' +number & col_tk2(n) =col fxbaddcol,col,header,dataf,'E_TK2' +number & col_e_tk2(n) =col fxbaddcol,col,header,dataf,'PEAK2' +number & col_peak2(n) =col fxbaddcol,col,header,dataf,'E_PEAK2' +number & col_e_peak2(n) =col fxbaddcol,col,header,dataf,'AREAG2' +number & col_areag2(n) =col fxbaddcol,col,header,dataf,'E_AREAG2'+number & col_e_areag2(n)=col fxbaddcol,col,header,dataf,'RAT12' +number & col_rat12(n) =col fxbaddcol,col,header,dataf,'E_RAT12' +number & col_e_rat12(n) =col endfor for n=0,5 do begin number=strcompress(n,/remove_all) fxbaddcol,col,header,dataf,'SPEED' +number & col_speed(n) =col fxbaddcol,col,header,dataf,'TPAR' +number & col_tpar(n) =col endfor endif ; ; Write out extension header: ; fxbcreate,unit,path+file,header ; ; Write image data: ; for n=0,ws.k.nimage-1 do fxbwrite,unit,ws.d(*,*,n),col_data(n),1 ; if ws.k.status eq 'im_syn' then goto, jump1 ; ; Write data/err (Image Data only) ; if (ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit') and $ ws.k.tdim_dd ne 0 then begin for n=0,ws.k.nimage-1 do begin fxbwrite,unit,ws.dd(*,*,n),col_datadd(n),1 endfor for n=0,ws.k.nimage-1 do begin fxbwrite,unit,ws.err(*,*,n),col_dataer(n),1 endfor endif ; ; Write ws.fit keywords (Fit Data only) ; if ws.k.status eq 'im_fit' then begin fxbwrite,unit,ws.fit.dist ,col_dist ,1 fxbwrite,unit,ws.fit.theta ,col_theta,1 fxbwrite,unit,ws.fit.oratio ,col_oratio,1 fxbwrite,unit,ws.fit.e_oratio,col_e_oratio,1 fxbwrite,unit,ws.fit.tte ,col_tte,1 fxbwrite,unit,ws.fit.dde ,col_dde,1 for n=0,ws.k.nimage-1 do begin fxbwrite,unit,ws.fit.ifbin(*,*,n) ,col_ifbin(n),1 fxbwrite,unit,ws.fit.chi(*,*,n) ,col_chi(n) ,1 fxbwrite,unit,ws.fit.lamb(*,*,n) ,col_lamb(n),1 fxbwrite,unit,ws.fit.e_lamb(*,*,n) ,col_e_lamb(n),1 fxbwrite,unit,ws.fit.sig(*,*,n) ,col_sig(n),1 fxbwrite,unit,ws.fit.e_sig(*,*,n) ,col_e_sig(n),1 fxbwrite,unit,ws.fit.vel1e(*,*,n) ,col_vel1e(n),1 fxbwrite,unit,ws.fit.e_vel1e(*,*,n) ,col_e_vel1e(n),1 fxbwrite,unit,ws.fit.tk1(*,*,n) ,col_tk1(n),1 fxbwrite,unit,ws.fit.e_tk1(*,*,n) ,col_e_tk1(n),1 fxbwrite,unit,ws.fit.peak(*,*,n) ,col_peak(n),1 fxbwrite,unit,ws.fit.e_peak(*,*,n) ,col_e_peak(n),1 fxbwrite,unit,ws.fit.areag(*,*,n) ,col_areag(n),1 fxbwrite,unit,ws.fit.e_areag(*,*,n) ,col_e_areag(n),1 fxbwrite,unit,ws.fit.bck(*,*,n) ,col_bck(n),1 fxbwrite,unit,ws.fit.e_bck(*,*,n) ,col_e_bck(n),1 fxbwrite,unit,ws.fit.lamb2(*,*,n) ,col_lamb2(n),1 fxbwrite,unit,ws.fit.e_lamb2(*,*,n) ,col_e_lamb2(n),1 fxbwrite,unit,ws.fit.sig2(*,*,n) ,col_sig2(n),1 fxbwrite,unit,ws.fit.e_sig2(*,*,n) ,col_e_sig2(n),1 fxbwrite,unit,ws.fit.vel1e2(*,*,n) ,col_vel1e2(n),1 fxbwrite,unit,ws.fit.e_vel1e2(*,*,n),col_e_vel1e2(n),1 fxbwrite,unit,ws.fit.tk2(*,*,n) ,col_tk2(n),1 fxbwrite,unit,ws.fit.e_tk2(*,*,n) ,col_e_tk2(n),1 fxbwrite,unit,ws.fit.peak2(*,*,n) ,col_peak2(n),1 fxbwrite,unit,ws.fit.e_peak2(*,*,n) ,col_e_peak2(n),1 fxbwrite,unit,ws.fit.areag2(*,*,n) ,col_areag2(n),1 fxbwrite,unit,ws.fit.e_areag2(*,*,n),col_e_areag2(n),1 fxbwrite,unit,ws.fit.rat12(*,*,n) ,col_rat12(n),1 fxbwrite,unit,ws.fit.e_rat12(*,*,n) ,col_e_rat12(n),1 endfor for n=0,5 do begin number=strcompress(n,/remove_all) fxbwrite,unit,ws.fit.speed(*,*,n) ,col_speed(n),1 fxbwrite,unit,ws.fit.tpar(*,*,n) ,col_tpar(n),1 endfor endif jump1: ; fxbfinish,unit ;compress FITS filez=ws.k.path+ws.k.file comp='compress -f '+filez spawn,comp, /sh ; SG 12/01 filez=filez+'.Z' ; print,'% FITS ',filez,' saved on ',ws.k.path ; return end ; ; ;----------------------------------------------------------------------- ; Procedure UVCS_FITS_READ_IMA ; Read Image Data File ; ; Calls Procedures : ; POP_UP ; OPEN_ALL ; ; Carlo Benna ; ; Jun 27 96 ; May 22 97 ; Nov 27 97 ; Dec 05 97 ; Apr 09 98 Silvio Giordano ; Feb 19 99 all FITS read from /tmp directory Carlo ; May 5 99 read ws.k.orb_file, ws.k.orb_path Carlo ; May 12 99 ws.fit keywords read from Binary Table Carlo ; May 14 99 read ws.k.tnfile, ws.k.dsfile Carlo ; May 21 99 ws.fit new keywords saved on Binary Table ; (ifbin, oratio, e_oratio, tte, dde) Carlo ; May 21 99 added new if for "im_fit" status Carlo ; May 25 99 update tag .ifbin(slt,mir,nimg) to image index Carlo ; May 27 99 fixed bug about read Fit synoptic FITS file Carlo ; Nov 19 99 fixed bug about read ima old FITS file Carlo-SG ; Jul 6 00 fixed bug about read synoptic FITS file Carlo ; Nov 17 00 Changed POP_UP Error message to open FITS file Carlo ; Dec 28 01 update to DAS33 SG 12/01 ; Jun 04 04 ws.fit.lam2 and ws.fit.e_lam2 added ;----------------------------------------------------------------------- pro UVCS_FITS_READ_IMA,ws,stat,path,file common wd_mn,wid_main ; widget_control,wid_main,/hourglass ; ;Not a FITS File pos=strpos(file,'.dat') if pos eq -1 then pos=strpos(file,'.wav') if pos eq -1 then pos=strpos(file,'.rad') if pos eq -1 then pos=strpos(file,'.ima') if pos eq -1 then pos=strpos(file,'.syn') if pos eq -1 then begin OPEN_ALL,stat,path,file,res stat='None' path='' file='None' return endif pos=strpos(file,'ima') if pos eq -1 then pos=strpos(file,'syn') stat1=strmid(file,pos,3) if stat1 ne 'ima' AND stat1 ne 'syn' then begin POP_UP,'Error',' Not an Image or Synoptic Data File' stat='None' path='' file='None' return endif ; ;Copy FITS in /tmp directory, and uncompress if in *.Z format lun=strlen(file) pos=strpos(file,'.Z') open_path='/tmp/' filez=path+file ;print,'% FITS copied from: ',filez tmpfile=open_path+file ;print,'% to: ',tmpfile copy='cp '+filez+' '+tmpfile spawn,copy, /sh if pos eq lun-2 then begin uncp='uncompress '+tmpfile print,'% ',uncp spawn,uncp, /sh ; SG 12/01 file=strmid(file,0,pos) endif ; ; Open FITS file (from /tmp directory ALWAYS) ; openr,unit,open_path+file,error=err,/get_lun if err ne 0 then begin POP_UP,'Error','Correct path not specified - Cannot access file '+path+file stat='None' path='' file='None' return endif ; ; Read FITS primary header: ; fxhread,unit,primary_header,stf if stf ne 0 then print,'ERROR: status=',stf ; ; Read keywords ; if stat1 eq 'ima' then begin ikey={IKEY} ikey.index = ws.k.index ikey.wid_main = wid_main widg={WIDG, im_draw_ima: 0l, im_cont_ima: 0l, im_draw_plt: 0l} ws={k: ikey, d: 0, dd: 0, err: 0, w: widg} endif if stat1 eq 'syn' then begin skey={SKEY} skey.index = ws.k.index skey.wid_main = wid_main widgs={WIDGS, sy_draw_ima: 0l} ws={k: skey, d: 0, w:widgs} endif ; ; ;------------------------------------------------------------------------- ; Read FITS File: ;------------------------------------------------------------------------- ; ; Read keywords for Image and Synoptic Data ; ws.k.file =strcompress(fxpar(primary_header,'FILE' ),/remove_all) ws.k.path =strcompress(fxpar(primary_header,'PATH' ),/remove_all) ws.k.filename=strcompress(fxpar(primary_header,'FILENAME' ),/remove_all) ws.k.date =strcompress(fxpar(primary_header,'DATE' ),/remove_all) ws.k.sp_onum =strcompress(fxpar(primary_header,'SP_ONUM' ),/remove_all) ws.k.sp_path =strcompress(fxpar(primary_header,'SP_PATH' ),/remove_all) ws.k.sp_file =strcompress(fxpar(primary_header,'SP_FILE' ),/remove_all) ws.k.cal_file=strcompress(fxpar(primary_header,'CAL_FILE' ),/remove_all) ws.k.ext =strcompress(fxpar(primary_header,'EXT' ),/remove_all) ws.k.origin =strcompress(fxpar(primary_header,'ORIGIN' ),/remove_all) ws.k.telescop=strcompress(fxpar(primary_header,'TELESCOP' ),/remove_all) ws.k.instrume=strcompress(fxpar(primary_header,'INSTRUME' ),/remove_all) ws.k.expcount= fxpar(primary_header,'EXPCOUNT' ) ws.k.date_obs=strcompress(fxpar(primary_header,'DATE_OBS')) ws.k.date_end=strcompress(fxpar(primary_header,'DATE_END')) ws.k.status =strcompress(fxpar(primary_header,'STATUS' ),/remove_all) ws.k.nimage = fxpar(primary_header,'NIMAGE' ) ws.k.nima = fxpar(primary_header,'NIMA' ) ws.k.int_typ =strcompress(fxpar(primary_header,'INT_TYP' ),/remove_all) ; ;Read keywords for Image and Fit Data only ; if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin for n=0,ws.k.expcount-1 do begin number=strcompress(n,/remove_all) ws.k.mirangls(n)=fxpar(primary_header,'MIRANG'+number) ws.k.wdth(n)=fxpar(primary_header,'WDTH'+number) ws.k.exptimes(n)=fxpar(primary_header,'EXPTIME'+number) if n ne ws.k.expcount-1 then $ ws.k.noe_wdth(n)=fxpar(primary_header,'NOE_WD'+number) endfor endif ; ; Read keywords for Image, Fit and Synoptic Data ; for n=0,ws.k.nimage-1 do begin number=strcompress(n,/remove_all) ws.k.ipol(n)=strcompress(fxpar(primary_header,'IPOL'+number),/remove_all) ws.k.ttype(n)=strcompress(fxpar(primary_header,'TTYPE'+number),/remove_all) ws.k.wmin(n)=fxpar(primary_header,'WMIN'+number) ws.k.wmax(n)=fxpar(primary_header,'WMAX'+number) ws.k.desc(n)=strcompress(fxpar(primary_header,'DESC'+number),/remove_all) ws.k.wmin1(n)=fxpar(primary_header,'W1'+number) ws.k.wmax1(n)=fxpar(primary_header,'W2'+number) ws.k.trcal(n)=fxpar(primary_header,'TRCAL'+number) ws.k.wdelt(n)=fxpar(primary_header,'WDELT'+number) endfor ws.k.detector =strcompress(fxpar(primary_header,'DETECTOR'),/remove_all) ws.k.ncol_img =fxpar(primary_header,'NCOL_IMG') ws.k.nrow_img =fxpar(primary_header,'NROW_IMG') ws.k.colwdth =fxpar(primary_header,'COLWDTH') ; ;Read keywords for Image and Fit Data only ; if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin ws.k.rowngrp =fxpar(primary_header,'ROWNGRP ') ws.k.rowfrst =fxpar(primary_header,'ROWFRST ') ws.k.rowact =fxpar(primary_header,'ROWACT ') ws.k.rowspc =fxpar(primary_header,'ROWSPC ') endif ; ; Read keywords for Image, Fit and Synoptic Data ; ws.k.mm_r =fxpar(primary_header,'MM_R') ws.k.arc_r =fxpar(primary_header,'ARC_R') ; ;Read keywords for Image and Fit Data only ; if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin ws.k.rminpx =fxpar(primary_header,'RMINPX') ws.k.yminpx =fxpar(primary_header,'YMINPX') ws.k.angle =fxpar(primary_header,'ANGLE') ws.k.tdim_dd =fxpar(primary_header,'TDIM_DD') ws.k.tdim_bck =fxpar(primary_header,'TDIM_B') ws.k.trval_bck=fxpar(primary_header,'TRVAL_B') ws.k.tdelt_bck=fxpar(primary_header,'TDELT_B') ws.k.orb_file =fxpar(primary_header,'ORB_FILE') ws.k.orb_path =fxpar(primary_header,'ORB_PATH') ws.k.tnfile =fxpar(primary_header,'TNFILE') ws.k.dsfile =fxpar(primary_header,'DSFILE') endif ;Temporary if ws.k.status eq 'im_syn' then ws.k.siz=fxpar(primary_header,'SIZ') extname=strcompress(fxpar(primary_header,'EXTNAME'),/remove_all) ; ; Read Binary Table Extension: ; fxbopen,unit,open_path+file,extname,header if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then $ wsx=fltarr(ws.k.nrow_img,ws.k.ncol_img,ws.k.nimage) if ws.k.status eq 'im_syn' then wsx=fltarr(ws.k.siz,ws.k.siz,ws.k.nimage) if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin if ws.k.tdim_dd ne 0 then begin wsd=fltarr(ws.k.tdim_dd,ws.k.expcount,ws.k.nimage) wse=wsd endif endif for n=0,ws.k.nimage-1 do begin number=strcompress(n,/remove_all) ; ;Image Data if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin m=strcompress(fxbcolnum(unit,'DATA_IMG'+number),/remove_all) ws.k.tdim(*,n) =fxbtdim(fxpar(header,'TDIM'+m)) ws.k.tdesc(*,n)=fxbtdim(fxpar(header,'TDESC'+m)) ws.k.trval(*,n)=fxbtdim(fxpar(header,'TRVAL'+m)) ws.k.tdelt(*,n)=fxbtdim(fxpar(header,'TDELT'+m)) ws.k.tsize(*,n)=fxbtdim(fxpar(header,'TSIZE'+m)) endif ; ;Read Data Array: ; fxbread,unit,wsxd,'DATA_IMG'+number ; ; Write image data: ; wsx(*,*,n)=wsxd ; endfor ; ;if ws.k.tdim_dd eq 0 then goto, old_fits ;CB Nov19 99 ; if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin ; if ws.k.tdim_dd eq 0 then goto, old_fits ;CB Nov19 99 ;moved here on Jul 6, 2000 ; ; Fit Result Structure Definition: ws.fit ; fp =fltarr(ws.k.tdim_dd, ws.k.expcount) fr =fltarr(ws.k.tdim_dd, ws.k.expcount, ws.k.nimage) fs =fltarr(ws.k.tdim_dd, ws.k.expcount, 6) ; res = {dist: fp, theta: fp, ifbin: fr, chi: fr, lamb: fr, e_lamb : fr, $ sig: fr, e_sig: fr, vel1e: fr, e_vel1e: fr, tk1: fr, e_tk1: fr, $ peak: fr, e_peak: fr, areag: fr, e_areag: fr, bck: fr, e_bck: fr, $ lamb2: fr, e_lamb2: fr, $ sig2: fr, e_sig2: fr, vel1e2: fr, e_vel1e2: fr, tk2: fr, e_tk2: fr, $ peak2: fr, e_peak2: fr, areag2: fr, e_areag2: fr, rat12: fr, e_rat12: fr, $ oratio: fp,e_oratio: fp, tte: fp, dde: fp, speed: fs, tpar: fs } ; for n=0,ws.k.nimage-1 do begin number=strcompress(n,/remove_all) ; ;Read data end their errors (Image and Fit Data only): ; fxbread,unit,wsxdd,'DATA_DD'+number wsd(*,*,n)=wsxdd fxbread,unit,wsxde,'DATA_ER'+number wse(*,*,n)=wsxde ws={k: ws.k, d: wsx, dd: wsd, err: wse, w: widg, fit: res} endfor endif old_fits: if ws.k.status eq 'im_mir' or ws.k.status eq 'im_fit' then begin if ws.k.tdim_dd eq 0 then ws={k: ws.k, d: wsx, dd: 0, err: 0, w:widg} endif if ws.k.status eq 'im_syn' then ws={k: ws.k, d: wsx, w:widgs} ; fxbclose,unit ; stat=ws.k.status ; ;Delete file copied on /tmp directory delfile='/bin/rm '+open_path+file spawn,delfile, /sh close,/all return end ;----------------------------------------------------------------------- ; Procedure IM2_MK_IMAG ; Management of the widgets related with Make Images ; ; Inputs : wsb (spectral data) ; ; Outputs: ws (image data) ; ; Calls Procedures : IM_COMP ; IM2_MK_IMAG_EVENT ; POP_UP_OK ; POP_UP ; RATIO_SEL ; ; Carlo Benna ; ; Sep 04 96 Ratio Images ; Aug 22 96 Bug introduced by distorsion correction ; "0:wsb.k.tdim(0,0)-1" instead of "*" ; Nov 27 97 ; Feb 09 98 new status: sp_wav_str ; Feb 24 98 Gauss fit with instrum. corr. ---> sigma image "SGI" ; Pure Gauss fit ---> sigma image "SGP" ; Mar 04 98 ; Apr 17 98 SGI ---> GSI ; SGP ---> PGS ; Apr 24 98 Bug deleting image from first panel ; Apr 27 98 RATIO_SEL ; May 06 98 ws.k.trval_bck ws.k.tdelt_bck ; May 12 98 ysize of make image widget ; Oct 28 98 redundant wav per not dat data ; Nov 06 98 ; Apr 16 99 orb_path and orb_file in image ws ; IF1 Instr. Corr. ONE Gaussian Fit ; Structure ws.fit ; May 04 99 common ifit_res,n_fit_res n_fit_res=16 ; May 06 99 add tags: ws.fit.speed and ws.fit.tpar ; May 12 99 add tags for errors of fit, es ws.fit.e_lamb ; n_fit_res=29 ; May 21 99 add tags: ws.fit.oratio, .e_oratio, .tte, .dde ; May 21 99 add tag: ws.fit.ifbin Carlo ; May 26 99 n_fit_res=30 ; Jun 29 99 bug: 'ifbin: fp' , now: 'ifbin: fr' ; Feb 22 01 comments ; Dec 28 01 change common name from mk to uvcs_mk ; (consistency with DAS33) ; Aug 02 02 make images from data with same CMDMIR (MIRPOS) but ; with different MIRANGL ; Order Exposures for increasing MIRANGL ; Aug 20 02 print removed ; Jan 14 03 new variable "out_opt" in common ifit_res ; Nov 12 03 same MIRANGL verified up to .xxx not only up to 0.xx ; Jun 02 04 n_fit_res=32 ; ; Silvio Giordano ;----------------------------------------------------------------------- pro IM2_MK_IMAG,ws,stat,path,file,wsb,stat_b,path_b,file_b ; common uvcs_mk,uvalue,tdim,trval,tdelt,trcal,wdelt,wmin,wmax,desc,text, $ nima,list,from,to,interp,dataty,descr,wmin1,wmax1 common new,nimage,ipol,ityp,det,pan,panel,wsx,w_from,w_to,pan1 common rat,wmin1_temp,wmax1_temp,des,pan1_temp,pan_temp common ifit_res,n_fit_res,out_opt ; n_fit_res=32 ; numero di parametri che identificano il fit ; if ws.k.status ne 'None' then begin title='Warning' text=' Do you want to overwrite the Data Set A ?' POP_UP_OK, title, text, ans if ans eq 'Cancel' then return endif wsx=wsb ; if stat_b ne 'sp_rad' AND $ stat_b ne 'sp_wav' AND $ stat_b ne 'sp_wav_bck' AND $ stat_b ne 'sp_wav_str'then begin POP_UP,'Error','Data Status not Good to Build Images' return endif ; ; SG08/02 begin ; ; Case of exposures with same MIRANGL : sum before make image ; Nmirangl = N_DIFF(APPROX(wsb.f.mirangl,3,STR='NO')) ; SG 11/03 if Nmirangl lt wsb.k.expcount then begin text=strarr(3) text(0)='Sum All Exposures at Same Pointing (MIRANGL)' text(1)=' Before Make Images ' text(2)=' (Use Combine/Delete Exposures) ' POP_UP,'Error',text return endif ; ; Verify number of Commanded Mirrors ; ; Case of exposures with same MIRPOS and so CMDMIR Nmirpos = N_DIFF(APPROX(wsb.f.mirpos,-1.,STR='NO')) if Nmirpos lt wsb.k.expcount then begin text1=' Spectral Fits Contains Exposures with same MIRPOS ' text2='' text3=' Continue ? ' text=[text1,text2,text3] title='Warning' POP_UP_YN, title, text, ans if ans eq 'no' then return endif ; ; Order Exposures for increasing MIRANGL ; if wsb.k.expcount ge 2 then begin grup=-1 for i=0,wsb.k.expcount-2 do $ if wsb.f(i).mirangl gt wsx.f(i+1).mirangl then grup=-2 if grup eq -2 then begin POP_UP_SC,'Action',' Exposures must be ordered by MIRANGL ',ans if ans eq 'Cancel' then return if ans eq 'Order' then begin i=indgen(wsb.k.expcount) a=SORT(wsb.f.mirangl) wsb.f(i)=wsb.f(a) wsb.d(*,*,i)=wsb.d(*,*,a) endif endif endif ; ;SG08/02 end ; if stat_b eq 'sp_wav' OR $ stat_b eq 'sp_wav_bck' OR $ stat_b eq 'sp_wav_str' then begin POP_UP,'Warning','Building Images for Non Rad. Data' endif ; ; Fix bug occasionally introduced by distorsion correction ind=where(wsb.k.tdim(0,*) gt 0, cnt) if cnt ne 0 then wsb.k.tdim(0,ind)=min(wsb.k.tdim(0,ind)) ; ; Fix bug deleting image from first panel (from basic bug) wsb.k.tdim(0,0:wsb.k.ndata-1)=wsb.k.tdim(0,0) ; ; Build "Make Images" widget ; det=wsb.k.detector nimage=wsb.k.ndata tdim =wsb.k.tdim trval =wsb.k.trval tdelt =wsb.k.tdelt wmin=fltarr(15) wmax=fltarr(15) wmin1=fltarr(15) wmax1=fltarr(15) wmin1_temp=0 & wmax1_temp=0 & des='' & pan1_temp=-1 ipol =strarr(15)+'YES' ityp =strarr(15)+'INT' desc =strarr(15) pan =intarr(15) pan1 =intarr(15)-1 ; ; Loop over all panel ; for p=0, wsb.k.ndata-1 do begin if wsb.k.detector eq 'OVI' then begin if wsb.k.status ne 'sp_rad' AND strmid(ws.k.status,0,6) eq 'sp_wav' then begin title='Red or Not Red ?!' text='Does the panel # '+STRCOMPRESS(p,/rem)+ ' contain Redundat LYA ?' POP_UP_YN,title,text,ans if ans eq 'yes' then wsb.k.trcal(p)=1 endif endif t=wsb.k.trcal(p) wmin(p) = wsb.f(0).wrval(t) + wsb.f(0).wdelt(t) * $ (wsb.k.trval(1,p) + wsb.k.tdelt(1,p) * 0) wmax(p) = wsb.f(0).wrval(t) + wsb.f(0).wdelt(t) * $ (wsb.k.trval(1,p) + wsb.k.tdelt(1,p) * (wsb.k.tdim(1,p)-1)) ; ;Note: if LYA or OVI primary then wmin > wmax ===> reverse ; only if OVI redundant then wmin < wmax if t eq 0 then begin tmp=wmin(p) wmin(p)=wmax(p) wmax(p)=tmp endif endfor ; for n=0,nimage-1 do begin desc(n)='Panel'+strcompress(n) pan(n)=n endfor base=widget_base(title='Make Images', xoffset=20,yoffset=250,/column, $ group_leader = wsb.k.wid_main, /modal) text=strarr(nimage) empty=' ' for n=0,nimage-1 do begin if n ge 10 then empty=' ' text(n)=string(empty,strcompress(n),tdim(1,n),wmin(n),wmax(n), $ ' ',ipol(n),' ',ityp(n),' ',desc(n)) endfor tex=text(0) & strput,tex,'>',0 & text(0)=tex & nima=0 txt1=widget_label(base,value='File: '+path_b+file_b,resource_name='white') txt2 =widget_label(base,value='IMAGE TDIM Wav-min Wav-max Interp. Image type Description ') list =widget_list(base,value=text,uvalue='List',ysize=8, $ resource_name='white') arow =widget_base(base,/row) from =cw_field(arow,title='From:',value=wmin(0),xsize=7,/row,/floating) to =cw_field(arow,title='To:' ,value=wmax(0),xsize=7,/row,/floating) mouse =widget_button(arow,value=' Mouse ',uvalue=' Mouse ', $ resource_name='blue') null =widget_label(arow,value=' ') descr =cw_field(arow,title='Description:',value=desc(0),xsize=12,/row) panel=pan(0) a2row =widget_base(base,/row,space=30) txt3 =widget_label(a2row,value=' Interpolation Image Type') brow =widget_base(base,/row,space=30) interp =cw_bgroup(brow,['YES','NO'],uvalue='isel',/exclusive,/row, $ set_value=0) ;dataty =cw_bgroup(brow,['INT','MN1','MN2','MN3','???','PGS'], $ dataty =cw_bgroup(brow,['INT','MN1','MN2','MN3'], $ uvalue='dsel',/exclusive,/row, set_value=0) ratio =widget_button(brow,value=' Ratio ',uvalue=' Ratio ', $ resource_name='magenta') info =widget_button(brow,value=' Info ',uvalue=' Info ', $ resource_name='blue') crow =widget_base(base,column=5) copy_extract=widget_button(crow,value=' Copy / Modify ', $ uvalue=' Copy / Modify ', $ resource_name='red') delete =widget_button(crow,value='Delete' ,uvalue='Delete', $ resource_name='red') null1 =widget_label(crow,value=' ') done =widget_button(crow,value='Done' ,uvalue='Done', $ resource_name='green') cancel =widget_button(crow,value='Cancel' ,uvalue='Cancel', $ resource_name='green') widget_control,base,/realize, /hourglass XMANAGER,'IM2_MK_IMAG',base if uvalue eq 'Cancel' then return ; ; Fit Result Structure Definition SOLO PER COMPATIBILITA' ; fp =fltarr(wsb.k.tdim(0,0), wsb.k.expcount) ; SG08/02 fr =fltarr(wsb.k.tdim(0,0), wsb.k.expcount, nimage) ; SG08/02 fs =fltarr(wsb.k.tdim(0,0), wsb.k.expcount, 6) ; SG08/02 res = {dist: fp, theta: fp, ifbin: fr, chi: fr, lamb: fr, e_lamb: fr, $ sig: fr, e_sig: fr, vel1e: fr, e_vel1e: fr, tk1: fr, e_tk1: fr, $ peak: fr, e_peak: fr, areag: fr, e_areag: fr, bck: fr, e_bck: fr, $ lamb2: fr, e_lamb2: fr, $ sig2: fr, e_sig2: fr, vel1e2: fr, e_vel1e2: fr, tk2: fr, e_tk2: fr, $ peak2: fr, e_peak2: fr, areag2: fr, e_areag2: fr, rat12: fr, e_rat12: fr, $ oratio: fp,e_oratio: fp, tte: fp, dde: fp, speed: fs, tpar: fs } ; ; Write Values in Structure for Image Data ws ; indx=ws.k.index ikey={IKEY} widg={WIDG, im_draw_ima: 0l, im_cont_ima: 0l, im_draw_plt: 0l} ws={k: ikey, d: 0, dd:0, err:0, w: widg, fit: res} ws.k.index=indx ws.k.file=strmid(wsb.k.file,0,strlen(wsb.k.file)-3)+'ima' ws.k.filename=ws.k.file ws.k.sp_path=wsb.k.path ws.k.sp_file=wsb.k.file ws.k.orb_path=wsb.k.orb_path ws.k.orb_file=wsb.k.orb_file ws.k.sp_onum=wsb.k.obs_num ws.k.ext=wsb.k.ext ws.k.origin='OATO' ws.k.telescop=wsb.k.telescop ws.k.instrume=wsb.k.instrume ws.k.expcount = wsb.k.expcount ; SG08/02 ws.k.detector=wsb.k.detector ws.k.date_obs=wsb.k.date_obs ws.k.date_end=wsb.k.date_end ws.k.status='im_mir' ws.k.nimage=nimage ws.k.wid_main=ws.k.wid_main ws.k.ttype=ityp ws.k.ipol=ipol ws.k.tdim=tdim ws.k.tdelt=tdelt ws.k.trval=trval ws.k.tdim_dd=tdim(0,0) ws.k.cal_file=wsb.k.cal_file ws.k.tsize=wsb.k.tsize ws.k.tdim_bck=wsb.k.tdim_bck ws.k.trval_bck=wsb.k.trval_bck ws.k.tdelt_bck=wsb.k.tdelt_bck if (wsb.f(0).rolangl gt -180) and (wsb.f(0).rolangl le 90) then $ ws.k.angle = 90. - wsb.f(0).rolangl else $ ws.k.angle = 450. - wsb.f(0).rolangl if stat_b eq 'sp_wav' OR $ stat_b eq 'sp_wav_bck' OR $ stat_b eq 'sp_wav_str' then $ ws.k.int_typ = 'cnt' else ws.k.int_typ = 'int' ; ws.k.wmin=wmin ws.k.wmax=wmax ws.k.desc=desc ws.k.wmin1=wmin1 ws.k.wmax1=wmax1 ws.k.pan=pan ws.k.pan1=pan1 ; ; Compute Images ; IM_COMP, ws, wsb ; stat=ws.k.status path=ws.k.path file=ws.k.file ; end ; ;------------------------------------------------------------------------- ; Event handler for Make Images widget ;------------------------------------------------------------------------- pro IM2_MK_IMAG_EVENT,ev ; common uvcs_mk,uvalue,tdim,trval,tdelt,trcal,wdelt,wmin,wmax,desc,text, $ nima,list,from,to,interp,dataty,descr,wmin1,wmax1 common new,nimage,ipol,ityp,det,pan,panel,wsx,w_from,w_to,pan1 common rat,wmin1_temp,wmax1_temp,des,pan1_temp,pan_temp ; wpol=intarr(n_elements(ipol)) inx=where(ipol eq 'NO',cnt) if cnt ne 0 then wpol(where(ipol eq 'NO'))=1 wtyp=intarr(n_elements(ityp)) w0=where(ityp eq 'INT', cnt) if cnt ne 0 then wtyp(w0)=0 w1=where(ityp eq 'MN1', cnt) if cnt ne 0 then wtyp(w1)=1 w2=where(ityp eq 'MN2', cnt) if cnt ne 0 then wtyp(w2)=2 w3=where(ityp eq 'MN3', cnt) if cnt ne 0 then wtyp(w3)=3 w4=where(ityp eq '???', cnt) if cnt ne 0 then wtyp(w4)=4 w5=where(ityp eq 'PGS', cnt) if cnt ne 0 then wtyp(w5)=5 widget_control,ev.id,get_uvalue=uvalue ; ; uvalue = Mouse ; if uvalue eq ' Mouse ' then begin MOUSE, wsx, panel, w_from, w_to widget_control,from,set_value=w_from widget_control,to,set_value=w_to endif ; ; uvalue = Ratio ; if uvalue eq ' Ratio ' then begin RATIO_SEL,wsx,num,den,gobk if gobk eq 'OK' AND num ne den then begin wmin1_temp=wmin(den) wmax1_temp=wmax(den) pan_temp=pan(num) pan1_temp=pan(den) widget_control,from,set_value=wmin(num) widget_control,to ,set_value=wmax(num) des='Ratio' widget_control,descr,set_value='Ratio' uvalue = ' Copy / Modify ' goto,rat_cm endif endif ; ; uvalue = isel ; if uvalue eq 'isel' then begin if ev.value eq 1 then ipol(nima)='NO' if ev.value eq 0 then ipol(nima)='YES' endif ; ; uvalue = dsel ; if uvalue eq 'dsel' then begin if ev.value eq 0 then ityp(nima)='INT' if ev.value eq 1 then ityp(nima)='MN1' if ev.value eq 2 then ityp(nima)='MN2' if ev.value eq 3 then ityp(nima)='MN3' if ev.value eq 4 then ityp(nima)='???' if ev.value eq 5 then ityp(nima)='PGS' endif ; ; uvalue = Done or Cancel ; if uvalue eq 'Done' or uvalue eq 'Cancel' then begin widget_control,ev.top,/destroy return endif ; ; uvalue = List ; if uvalue eq 'List' then begin nima=ev.index widget_control,from,set_value=wmin(nima) widget_control,to ,set_value=wmax(nima) widget_control,interp,set_value=wpol(nima) widget_control,dataty,set_value=wtyp(nima) widget_control,descr,set_value=desc(nima) panel=pan(nima) endif ; ; uvalue = Delete ; if uvalue eq 'Delete' then begin if nimage le 1 then begin POP_UP,'Error','There is only one image' return endif else begin nimage=nimage-1 text=strarr(nimage) for k=nima,nimage-1 do begin tdim(*,k)=tdim(*,k+1) trval(*,k)=trval(*,k+1) tdelt(*,k)=tdelt(*,k+1) wmin(k)=wmin(k+1) wmax(k)=wmax(k+1) wmin1(k)=wmin1(k+1) wmax1(k)=wmax1(k+1) ipol(k)=ipol(k+1) ityp(k)=ityp(k+1) desc(k)=desc(k+1) pan(k)=pan(k+1) pan1(k)=pan1(k+1) endfor ;if deleting last line, move index ">" up to one if nima eq nimage then nima=nima-1 tdim(*,k)=0 trval(*,k)=0 tdelt(*,k)=0 wmin(k)=0 wmax(k)=0 wmin1(k)=0 wmax1(k)=0 ipol(k)=' ' ityp(k)=' ' desc(k)=' ' pan(k)=0 pan1(k)=-1 endelse endif ; rat_cm: ; ; uvalue = Copy/Modify ; if uvalue eq ' Copy / Modify ' then begin if nimage ge 15 then begin POP_UP,'Error','Cannot handle more than 15 images' return endif else begin widget_control,from,get_value=w_from widget_control,to,get_value=w_to if wmin1_temp eq 0 then begin ; to avoid check for Ratio Image a=string(w_from) & a=float(a) b=string(wmin(nima)) & b=float(b) if w_from gt wmax(nima) or a lt b then begin ; if ABS(w_from-wmin(nima)) lt 0.005 then w_from=wmin(nima) ; f w_from lt wmin(nima) or w_from gt wmax(nima) then begin print, format='(f12.6)',w_from print, format='(f12.6)',wmin(nima) print, format='(f12.6)',w_from - wmin(nima) POP_UP,'Error','WAV_FROM out of range' wmin1_temp=0 wmax1_temp=0 return endif a=string(w_to) & a=float(a) b=string(wmax(nima)) & b=float(b) if w_to lt wmin(nima) or a gt b then begin POP_UP,'Error','WAV_TO out of range' return endif if w_from ge w_to then begin POP_UP,'Error','WAV_FROM must be less than WAV_TO' return endif endif widget_control,interp,get_value=ii_pol if ii_pol eq 0 then i_pol='YES' if ii_pol eq 1 then i_pol='NO' widget_control,dataty,get_value=ii_typ if ii_typ eq 0 then i_typ='INT' if ii_typ eq 1 then i_typ='MN1' if ii_typ eq 2 then i_typ='MN2' if ii_typ eq 3 then i_typ='MN3' if ii_typ eq 4 then i_typ='???' if ii_typ eq 5 then i_typ='PGS' if des(0) ne 'Ratio' then begin widget_control,descr,get_value=des if strlen(des(0)) gt 15 then begin POP_UP,'Error','Description string must be less then 16 digit' return endif endif nimage=nimage+1 text=strarr(nimage) for k=nimage-1,nima+1,-1 do begin tdim(*,k)=tdim(*,k-1) trval(*,k)=trval(*,k-1) tdelt(*,k)=tdelt(*,k-1) wmin(k)=wmin(k-1) wmax(k)=wmax(k-1) wmin1(k)=wmin1(k-1) wmax1(k)=wmax1(k-1) ipol(k)=ipol(k-1) ityp(k)=ityp(k-1) desc(k)=desc(k-1) pan(k)=pan(k-1) pan1(k)=pan1(k-1) endfor endelse wmin(nima+1)=w_from wmax(nima+1)=w_to wmin1(nima+1)=wmin1_temp wmax1(nima+1)=wmax1_temp wmin1_temp=0 wmax1_temp=0 ipol(nima+1)=i_pol ityp(nima+1)=i_typ desc(nima+1)=des pan(nima+1)=pan(nima) if pan1_temp ne -1 then pan(nima+1)=pan_temp if pan1(nima) ne -1 then pan1(nima+1)=pan1(nima) pan1(nima+1)=pan1_temp pan1_temp=-1 nima=nima+1 endif ; empty=' ' for n=0,nimage-1 do begin if n ge 10 then empty=' ' tex=string(empty,strcompress(n),tdim(1,n),wmin(n),wmax(n), $ ' ',ipol(n),' ',ityp(n),' ',desc(n)) if n eq nima then strput,tex,'>',0 text(n)=tex endfor ; widget_control,list,set_value=text widget_control,interp,set_value=wpol(nima) widget_control,dataty,set_value=wtyp(nima) widget_control,descr,set_value=desc(nima) panel=pan(nima) ; ; uvalue = Info ; if uvalue eq ' Info ' then begin ;Read Spectral Lines Informations from routine MNM_RD (ima_disp_6.pro) NMN_RD,det,sp_line,wl_line k=n_elements(sp_line) inf=strarr(k+1) y_n=strarr(k+1) & y_n(0)=' ' ;loop over spectral lines database for j=0, k-1 do begin if y_n(j) eq 'yes' then goto, jump if wl_line(j) lt 700. then begin if wmin(nima)/2. lt wl_line(j)+1.5 and $ wmax(nima)/2. gt wl_line(j)-1.5 then $ y_n(j)='yes' else y_n(j)='no' endif else begin if wmin(nima) lt wl_line(j)+0.5 and $ wmax(nima) gt wl_line(j)-0.5 then $ y_n(j)='yes' else y_n(j)='no' endelse jump: endfor yes = where (y_n eq 'yes', count) if count eq 0 then begin inf=strarr(1) inf(0)=' No Spectral Lines in this Wavelength Range' goto, via endif sp_line=sp_line(yes) wl_line=wl_line(yes) k = n_elements(sp_line) inf=strarr(k+1) for j=0, k-1 do begin inf(j+1)=string(' ',sp_line(j),' ',wl_line(j)) endfor inf(0)=' Spectral Line Nominal Wavelength' via: title=' Expected Spectral Line '+' -- Image'+strcompress(nima) POP_UP,title,inf return ; endif ; wpol=intarr(n_elements(ipol)) inx=where(ipol eq 'NO',cnt) if cnt ne 0 then wpol(where(ipol eq 'NO'))=1 wtyp=intarr(n_elements(ityp)) w0=where(ityp eq 'INT', cnt) if cnt ne 0 then wtyp(w0)=0 w1=where(ityp eq 'MN1', cnt) if cnt ne 0 then wtyp(w1)=1 w2=where(ityp eq 'MN2', cnt) if cnt ne 0 then wtyp(w2)=2 w3=where(ityp eq 'MN3', cnt) if cnt ne 0 then wtyp(w3)=3 w4=where(ityp eq '???', cnt) if cnt ne 0 then wtyp(w4)=4 w5=where(ityp eq 'PGS', cnt) if cnt ne 0 then wtyp(w5)=5 end ;-----------------------------------------------------------------------; ; Procedure IMA_FITS_SHOW ; ; Sho