;logI=f(B) pro fituj,x,a,f,pder bx = EXP(A[1] * X) F = A[0] * bx + A[2] if n_params() ge 4 then pder= [[bx], [A[0] * X * bx],[replicate(1.0, N_ELEMENTS(X))]] end FUNCTION HUNT,array,value,position ;Numerical Recipes in C n = N_ELEMENTS(array) ascnd = (array(n - 1) GE array(0)) if ((position LE -1) OR (position GT (n-1))) then begin position = -1 ; input guess not usefull i_hi = n ; go to bisektor endif else begin inc = 1 if ((value GE array(position)) EQ ascnd) then begin ;hunt up if (position EQ n-1) then return,position i_hi = position + 1 while ((value GE array(i_hi)) EQ ascnd) do begin position = i_hi inc = inc + 1 i_hi = position + inc if (i_hi GT (n-1)) then begin i_hi = n goto, BISECTOR ; goto bisector endif endwhile endif else begin ;hunt down if (position EQ 0) then begin position = -1 return,position endif i_hi = position - 1 while ((value LT array(position)) EQ ascnd) do begin i_hi = position inc = 2*inc if (inc GE i_hi) then begin position = -1 goto, BISECTOR endif else position = i_hi - inc endwhile endelse endelse BISECTOR: while ((i_hi - position) NE 1) do begin i_m = (i_hi + position) / 2 if ((value GE array(i_m)) EQ ascnd) then position = i_m else i_hi = i_m endwhile if (value EQ array(0)) then position = 0 if (value EQ array(n-1)) then $ position = n-2 return,position END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FUNCTION GET_TAB,fileTAB,B0,l,b ;F_EXISTS,fileTAB,'GET_TAB' if ((b GT 90) OR (b LT -90) OR (l GT 90) OR (l LT -90)) then begin MESSAGE,'Bad values of l or b !',/noprefix,/informational,/continue MESSAGE,'(l,b)= -90 .. 90',/noprefix endif pi = 3.1415926d l = pi / 180 * l & b = pi / 180 * b & B0 = pi / 180 * B0 sin_theta = SQRT(1 - ((COS(b) * COS(B0) * COS(l)) + (SIN(b)*SIN(B0)))^2) sint = [0,0.6,0.8,0.9,0.95,0.98,0.99] OPENR,unit,fileTAB,/get_lun info = DBLARR(3) READF,unit,info coef = DBLARR(7) READF,unit,coef int = FLTARR(8,info(2)) READF,unit,int FREE_LUN,unit b = TOTAL(ALOG(coef)*ALOG(1-sint))/TOTAL((ALOG(1-sint))^2) fce = coef/(1-sint)^b ; zavislost sint na coef = (1-sint)^b * fce(sint) ; interpoluje se jen fce(sint) ld_coef = INTERPOL(fce,sint,sin_theta)*(1-sin_theta)^b index = WHERE(sin_theta LT sint,count) if ( count NE 0) then begin column = index(0) tab = [int(0,*),int(column:column+1,*)] data = {line : info(0),ld_coef : ld_coef, coef_tab : [coef(column - 1),coef(column)], tab : tab} endif else begin column = N_ELEMENTS(sint) PRINT,'get_data: Position of event is too close to the limb! Atlas intensity will not be precise!' tab = [int(0,*),int(column,*)] data = {line : info(0),ld_coef : ld_coef,tab : tab} endelse return, data END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FUNCTION T_INT,koef,range COMMON universal,tab,coef,cont N = N_ELEMENTS(range) if (N NE 0) then N = N - 1 l = ABS(koef(0) + koef(1) * range - tab.line) TInt = DBLARR(N+1) dim = SIZE(tab.tab) pos_lambda = 0 for i = 0, (N) do begin dist = l(i) pos_lambda = HUNT(tab.tab(0,*),dist,pos_lambda) if ((pos_lambda EQ -1) OR (pos_lambda EQ (dim(2) - 1))) then begin MESSAGE,'Value of lambda is not tabulated!',/noprefix endif ; interpolation using bilinear method (Numerical Recipes in C) t = (dist - tab.tab(0,pos_lambda)) / (tab.tab(0,pos_lambda + 1) - tab.tab(0,pos_lambda)) if (dim(1) EQ 3) then begin u = (tab.ld_coef - tab.coef_tab(0)) / (tab.coef_tab(1) - $ tab.coef_tab(0)) TInt(i) = tab.ld_coef * ((1 - t) * (1 - u) * tab.tab(1,pos_lambda) + t * (1 - u) * $ tab.tab(1,pos_lambda + 1) + t * u * tab.tab(2,pos_lambda + 1) + $ u * (1 - t) * tab.tab(2,pos_lambda)) endif else $ TInt(i) = tab.ld_coef * ((1 - t) * tab.tab(1,pos_lambda) + t * tab.tab(1,pos_lambda + 1)) endfor return,Tint END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FUNCTION POWFUNC, koef COMMON universal,tab,coef,cont COMMON SHARE,X,Y,pr,Isl,In COMMON HELP,pom,f,chyba TInt = T_INT(koef,pom) ;result = TOTAL(((f - pr(0)*TInt)/chyba)^2) result = TOTAL(((f - pr(0)*TInt))^2) koef = coef RETURN, result END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRO GFUNCT,x,a,f COMMON novy,zavoj,tma ;COMMON novy2,krivka COMMON spravnereseni,spravnyindex COMMON sedyfiltr,Ddelta T=1.0-((x-tma)/(zavoj-tma)) B=alog10(1/T-1) f=10^(a(0)+a(1)*B) END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRO CALCUL,myprof1,index,pocet_klinu,a,sigma COMMON universal,tab,coef,cont COMMON SHARE,X,Y,pr,Isl,In COMMON novy,zavoj,tma ;COMMON novy2,krivka COMMON sedyfiltr,Ddelta COMMON obecny,cara,button114 Nindex = N_ELEMENTS(index) Int = T_INT(coef,index) ;!!!!!!!!!!!!!!!!!!!!!!! Isl = TOTAL(Int)/Nindex In = TOTAL(myprof1(index,*),1)/DOUBLE(Nindex) m = DBLARR(pocet_klinu) for j=0,pocet_klinu - 1 do m(j) = MIN(myprof1(*,j)) if (cara eq 4) then begin ;**************************** nemuze byt pouzito minimum, nemusi byt totiz v care indexcary=fix((3933.700-coef(0))/coef(1)) for j=0,pocet_klinu - 1 do m(j) = myprof1(indexcary,j) endif if (cara eq 5) then begin indexcary=fix((3968.492-coef(0))/coef(1)) for j=0,pocet_klinu - 1 do m(j) = myprof1(indexcary,j) endif I_HA = TOTAL(T_INT(coef,(tab.line-coef(0))/coef(1))) X = dblarr(2*pocet_klinu) & Y =dblarr(2*pocet_klinu) X(0:pocet_klinu-1) = In(0:pocet_klinu-1) & Y(0:pocet_klinu-1) = pr*Isl X(pocet_klinu:*) = m(0:pocet_klinu-1) & Y(pocet_klinu:*) = I_HA*pr T=1.0-((X-tma)/(zavoj-tma)) X=alog10(1/T-1) ;(B) Y=alog10(Y) ;(logI) a=svdfit(X,Y,2,/double) END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRO CLB_CURV,myprof,a,reg_bounds,Id_klin = Id_klin COMMON scal,cekat,base3 COMMON clb,A_K1,myprofd,index1,pocet_klinu1,b1,a1,S21,nula3,fmin,iter,jedna3 COMMON universal,tab,coef,cont COMMON cesta,nazevsouboru COMMON udaje11,t11,t12,hranice1,hranice2,button1 COMMON novy,zavoj,tma COMMON SHARE,X,Y,pr,Isl,In COMMON HELP,pom,f,chyba COMMON obecny,cara,button114 ;COMMON novy2,krivka COMMON obrazek,image COMMON hlavicka,header COMMON sedyfiltr,Ddelta pocet_klinu = TOTAL(Id_klin) ;myprof(*,0:pocet_klinu-1)=myprof(*,0:pocet_klinu-1)+Ddelta ;odecteni sedeho filtru ;myprof(*,pocet_klinu)=myprof(*,pocet_klinu)+Ddelta zavoj=max(myprof)+1000 tma=min(myprof)-1000 ;zavoj=min(myprof)-1000 ;tma=max(myprof)+1000 ;----------------propustnosti klinu pro ruzne cary------------------------------ case cara of 1:begin pr=[0.927d,0.504d,0.250d,0.118d,0.0576d,0.0302d,0.0166d,0.00885d] end 2:begin pr=[0.900d,0.521d,0.269d,0.134d,0.0630d,0.0315d,0.0159d,0.00766d] end 3:begin pr=[0.958d,0.484d,0.228d,0.099d,0.0513d,0.0287d,0.0174d,0.0102d] end 4:begin pr=[0.885d,0.530d,0.279d,0.143d,0.0659d,0.0322d,0.0155d,0.0070d] end 5:begin pr=[0.886d,0.530d,0.279d,0.142d,0.0658d,0.0322d,0.0155d,0.0070d] ;****************** end endcase ;-------------------------------kontinuum---------------------------------------- pr = pr(where(pr * Id_klin)) ;vyber propustnosti pro zadane kliny down = MIN(myprof(cont(0):cont(1),0),max=up) index = where ((myprof(*,0) GE down) AND (myprof(*,0) LE up)) ;indexy v profilu kde je kontinuum ;--------------spocti koeficienty charakteristicke krivky pro kliny--------------- CALCUL,myprof,index,pocet_klinu,a,sigma ;zde se spocitaji kalibracni koeficienty ;------------------okno pro vykresleni charakteristicke krivky-------------------- nula3=widget_base(base3,/row) & jedna3=widget_base(nula3,/column) mez31=widget_base(jedna3,ysize=50) jedna32=widget_label(jedna3,value='Characteristic curve') jedna33=widget_draw(jedna3,xsize=400,ysize=400) mez32=widget_base(jedna3,ysize=10) widget_control,jedna33,get_value=comp & wset,comp xyouts,200,200,'WAIT...',charsize=2,alignment=0.5,/device ;------------zobrazeni charakteristicke krivky pred prepoctem disp. koeficientu--- widget_control,jedna33,get_value=nastav33 wset,nastav33 PLOT,X,Y,psym=2,xtitle = 'B',ytitle='logI' ;zobrazeni charakteristicke krivky osax=findgen(600)/100-3 OPLOT,osax,a(0)+a(1)*osax ;------------prepocet disp. koeficientu minimalizaci------------------------------ GFUNCT,myprof(*,0),a,f ;kalibrace 1. klinu ftol = 1.0e-4 xi = TRANSPOSE([[0.01,0.0],[0.0,0.001]]) pom1 = DINDGEN(N_ELEMENTS(myprof(*,0))) no_reg = N_ELEMENTS(reg_bounds(0,*)) no_points = 0 for j = 0, no_reg - 1 do begin no_points = no_points + reg_bounds(1,j) - reg_bounds(0,j) + 1 endfor pom = DINDGEN(no_points) pos = 0 for j = 0,no_reg - 1 do begin pom(pos) = pom1(reg_bounds(0,j):reg_bounds(1,j)) pos = pos + reg_bounds(1,j)-reg_bounds(0,j) + 1 endfor f = f(pom) ;& chyba = chyba(pom) coefdrive=coef POWELL,coef,xi,ftol,fmin,'POWFUNC',ITER=ITER,/double ;minimalizace ;-----------------okno pro zkalibrovany profil------------------------------------- chyba3=widget_base(/column) ;xsize=400 chybadraw=widget_draw(chyba3,xsize=400,ysize=300) if (fmin/N_ELEMENTS(pom) GT 4) then chyba31=widget_label(chyba3,value='High value of CHI2!') chyba32=widget_base(chyba3,/row) widget_control,chyba3,/realize ;-----------------zobrazeni zkalibrovaneho profilu pred prepoctem dips. koef.------- ; widget_control,chybadraw,get_value=nastavchyba ; wset,nastavchyba ; GFUNCT,myprof(*,0),a,f ;klin ; PLOT,coefdrive(0)+coefdrive(1)*pom1,f,psym=3 ; OPLOT,coefdrive(0)+coefdrive(1)*pom1,pr(0)*T_INT(coefdrive,pom1) ; GFUNCT,myprof(*,pocet_klinu),a,fklid ;klidne slunce ; kal=total(fklid(index))/double(n_elements(index)) ; K=Isl/kal ; PLOT,coefdrive(0)+coefdrive(1)*pom1,fklid*K,psym=3 ; OPLOT,coefdrive(0)+coefdrive(1)*pom1,T_INT(coefdrive,pom1) ; wait,2 ;------------znova vypocet koef. char. krivky po porepoctu disp. koef.--------------- CALCUL,myprof,index,pocet_klinu,a,sigma ;------------------zobrazeni charakteristicke krivky--------------------------------- widget_control,jedna33,get_value=nastav33 wset,nastav33 PLOT,X,Y,psym=2,xtitle = 'B',ytitle='logI' osax=findgen(600)/100-3 OPLOT,osax,a(0)+a(1)*osax napis='logI=a(0)+a(1)*B' ;----------------zobrazeni zkalibrovaneho a teoretickeho profilu---------------- widget_control,chybadraw,get_value=nastavchyba ;zobrazeni nafitovanych profilu wset,nastavchyba ; GFUNCT,myprof(*,0),a,f ;klin ; PLOT,coef(0)+coef(1)*pom1,f,psym=3,title='1st wedge' ; OPLOT,coef(0)+coef(1)*pom1,pr(0)*T_INT(coef,pom1) GFUNCT,myprof(*,pocet_klinu),a,fklid ;klidne slunce kal=total(fklid(index))/double(n_elements(index)) K=Isl*pr(0)/kal PLOT,coef(0)+coef(1)*pom1,fklid*K,psym=3,title='calibrated profile of quiet sun';,yrange=[0,120] ;*K OPLOT,coef(0)+coef(1)*pom1,T_INT(coef,pom1) ;----------------------kalibrace celeho obrazku-------------------------------- velikost=size(image) GFUNCT,image,a,novyobrazek novyobrazek=novyobrazek*K ;----------------------vypis vysledku a ulozeni zkalibrovaneho obrazku---------- coefup=fltarr(2) ;upravene koeficienty pro cely rozsah obrazku hran1=float(hranice1(0)) coefup(0)=coef(0)-coef(1)*hran1 coefup(1)=coef(1) mezera=widget_base(nula3,xsize=150) dva3=widget_base(nula3,/column) mez35=widget_base(dva3,ysize=80) reslab=widget_label(dva3,value='RESULTS',/align_left) mez33=widget_base(dva3,ysize=40) dvapom1=widget_base(dva3,/column,/frame) chlab=widget_label(dvapom1,value='CHI2: '+string(fmin),/align_left) iterlab=widget_label(dvapom1,value='Number of iterations: '+string(iter),/align_left) mez34=widget_base(dva3,ysize=40) dvapom2=widget_base(dva3,/column,/frame) xlab=widget_label(dvapom2,value=napis,/align_left) alab=widget_label(dvapom2,value='a0 '+string(a(0)),/align_left) blab=widget_label(dvapom2,value='a1 '+string(a(1)),/align_left) ; clab=widget_label(dvapom2,value='a2 '+string(a(2)),/align_left) ; if (krivka eq 3) then dlab=widget_label(dvapom2,value='a3 '+string(a(3)),/align_left) clab=widget_label(dvapom2,value='K '+string(K),/align_left) mez36=widget_base(dva3,ysize=40) dvapom3=widget_base(dva3,/column,/frame) colab=widget_label(dvapom3,value='Lambda=c0+c1*x',/align_left) co1lab=widget_label(dvapom3,value='c0 '+string(coefup(0)),/align_left) co2lab=widget_label(dvapom3,value='c1 '+string(coefup(1)),/align_left) pomzpet=widget_base(jedna3,/column) zpet3=widget_button(pomzpet,value='PREVIOUS',uvalue='DRUHA',xsize=150) lastocc=rstrpos(nazevsouboru,'\') ;vytvoreni cesty pro ulozeni if lastocc eq -1 then lastocc=rstrpos(nazevsouboru,'/') kolik=strlen(nazevsouboru)-lastocc-5 cesta=strmid(nazevsouboru,lastocc+1,kolik)+'_c.fts' str1=strcompress(velikost(1),/remove_all) ;vytvoreni hlavicky str2=strcompress(velikost(2),/remove_all) header=make_array(9,/string) header(0)='SIMPLE = T / Written by IDL: ' +!STIME header(1)='BITPIX = -64 / ' header(2)='NAXIS = 2 / ' header(3)='NAXIS1 = '+str1+' / ' header(4)='NAXIS2 = '+str2+' / ' header(5)='LAMBDA=C0+C1*X ' header(6)='C0='+string(coefup(0)) header(7)='C1='+string(coefup(1)) ;header(8)='K='+string(K) header(8)='END ' writefits,cesta,novyobrazek,header ;ulozeni zkalibrovaneho obrazku mez37=widget_base(dva3,ysize=20) ulozlab=widget_label(dva3,value='Calibrated image has been saved as '+cesta) ;****************** ;ukazky vysledu kalibrace ;cesta2=strmid(nazevsouboru,lastocc+1,kolik)+'_c.gif' ;wset,nastavchyba ;write_gif,cesta2,tvrd() ;****************** END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRO info11_event,event ;oblast profilu COMMON inner,myprofiles,profil,prof11,prof12,prof13,prof14,prof15,$ base1,prof16,base2,poloha2,ymyprof,zavedeno,jas,klin,jasnost COMMON udaje11,t11,t12,hranice1,hranice2,button1 COMMON obrazek,image COMMON pronovy,imageklin widget_control,event.id,get_uvalue=uvalue case uvalue of 'ZAVRI':BEGIN widget_control,t11,get_value=hranice11 widget_control,t12,get_value=hranice22 s=size(image) ;kontrola spravnosti (zda je oblast v obrazku) test=1 if (fix(hranice11(0)) lt 0) or (fix(hranice11(0)) gt s(1)) then test=0 if (fix(hranice22(0)) lt 0) or (fix(hranice22(0)) gt s(1)) then test=0 if fix(hranice11(0)) ge fix(hranice22(0)) then test=0 if test eq 1 then begin ;pokud spravne zadany rozsah widget_control,button1,sensitive=1 widget_control,event.top,/destroy if ((hranice11(0) ne hranice1(0)) or (hranice22(0) ne hranice2(0))) and (zavedeno eq 1) then begin if total(myprofiles) ne 0 then begin ;prekreslovani vytvorenych profilu myprofilespom=make_array(fix(hranice22(0))-fix(hranice11(0))+1,6,value=0.0) for i=0,5 do begin if total(myprofiles(*,i)) ne 0 then begin if (i eq 5) then aktobr=image else aktobr=imageklin oblast1=aktobr(fix(hranice11(0)):fix(hranice22(0)),ymyprof(i)-2:ymyprof(i)+2) ;image ips=make_array(fix(hranice22(0))-fix(hranice11(0))+1,value=0) for j=0,4 do ips=ips+float(oblast1(*,j)) & ips=ips/5 myprofilespom(*,i)=round(ips) endif endfor myprofiles=myprofilespom for i=0,5 do begin case i of 0:widget_control,prof11,get_value=nastav1 1:widget_control,prof12,get_value=nastav1 2:widget_control,prof13,get_value=nastav1 3:widget_control,prof14,get_value=nastav1 4:widget_control,prof15,get_value=nastav1 5:widget_control,prof16,get_value=nastav1 endcase wset,nastav1 plot,myprofiles(*,i),pos=[0,0,1,1],xstyle=4,ystyle=4 endfor endif endif hranice1=hranice11(0) & hranice2=hranice22(0) endif END endcase END PRO info12_event,event ;coordinates COMMON udaje12,t13,t14,longt,lat,t15,center widget_control,event.id,get_uvalue=uvalue case uvalue of 'ZAVRI':BEGIN widget_control,t13,get_value=longt widget_control,t14,get_value=lat widget_control,t15,get_value=center widget_control,event.top,/destroy END endcase END ;PRO info13_event,event ;grey filter ;COMMON sedyfiltr,Ddelta ;COMMON udaje13,t16,grey ;widget_control,event.id,get_uvalue=uvalue ;case uvalue of ;'ZAVRI':BEGIN ; widget_control,t16,get_value=grey & Ddelta=float(grey(0)) ; widget_control,event.top,/destroy ; END ;endcase ;END PRO info21_event,event ;disperse COMMON udaje21,voda2,alfa2,posvoda,posalfa COMMON udajenovy21,cara1,cara2,delka1,delka2 widget_control,event.id,get_uvalue=uvalue case uvalue of 'ZAVRI':BEGIN widget_control,voda2,get_value=posvoda widget_control,alfa2,get_value=posalfa widget_control,cara1,get_value=delka1 & delka1=delka1(0) widget_control,cara2,get_value=delka2 & delka2=delka2(0) widget_control,event.top,/destroy END endcase END PRO info22_event,event ;kontinuum COMMON udaje22,kont1,kont2,kontinuum1,kontinuum2 widget_control,event.id,get_uvalue=uvalue case uvalue of 'ZAVRI':BEGIN widget_control,kont1,get_value=kontinuum1 widget_control,kont2,get_value=kontinuum2 widget_control,event.top,/destroy END endcase END PRO info23_event,event ;minimizing COMMON udaje23,iksm11,iksm12,iksm21,iksm22,reg11,reg12,reg21,reg22 widget_control,event.id,get_uvalue=uvalue case uvalue of 'ZAVRI':BEGIN widget_control,iksm11,get_value=reg11 & widget_control,iksm12,get_value=reg12 widget_control,iksm21,get_value=reg21 & widget_control,iksm22,get_value=reg22 widget_control,event.top,/destroy END endcase END ;-------------------calib_event--------------------------- PRO fotocalib_event, event COMMON universal,tab,coef,cont COMMON udaje12,t13,t14,longt,lat,t15,center COMMON udaje23,iksm11,iksm12,iksm21,iksm22,reg11,reg12,reg21,reg22 COMMON udaje22,kont1,kont2,kontinuum1,kontinuum2 COMMON udaje21,voda2,alfa2,posvoda,posalfa COMMON udaje11,t11,t12,hranice1,hranice2,button1 COMMON udaje13,t16,grey COMMON vse,base,poloha,zac,im,zac2,w2,g1,zac3,jedna,dva,tri,basepoc,f1 COMMON inner,myprofiles,profil,prof11,prof12,prof13,prof14,prof15,$ base1,prof16,base2,poloha2,ymyprof,zavedeno,jas,klin,jasnost COMMON obrazek,image COMMON scal,cekat,base3 COMMON cesta,nazevsouboru COMMON foto,base111,oznobr COMMON knoflik,button11,button12,button13,button14,button15,button17,button18,button19 COMMON obecny,cara,button114 COMMON novy1,krbut ;COMMON novy2,krivka COMMON hlavicka,header COMMON udajenovy21,cara1,cara2,delka1,delka2 COMMON pronovy,imageklin WIDGET_CONTROL, event.id, GET_UVALUE=uvalue CASE uvalue OF 'QUIT':BEGIN widget_control,base,/destroy END 'START1':BEGIN widget_control,event.id,get_value=pom if dva eq 1 then widget_control,base2,/destroy ;z druhe obrazovky if tri eq 1 then widget_control,base3,/destroy ;z treti obrazovky if jedna eq 1 then widget_control,base1,/destroy ;z prvni obrazovky if pom(0) eq 'ENTER' then widget_control,basepoc,/destroy ;zacatek if (pom(0) eq 'LOAD') or (pom(0) eq 'ENTER') then begin ;zacatek widget_control,f1,sensitive=1 zac=0 & hranice1='' & hranice2='' & zac2=0 & zac3=0 posvoda='' & posalfa='' & kontinuum1='' & kontinuum2='' reg11='' & reg12='' & reg21='' & reg22='' & longt='' & lat='' zac=0 & jedna=0 & dva=0 & tri=0 & zavedeno=0 & postreti='' jasnost=0 & center='' ;& grey='' delka1='' & delka2='' klin=make_array(8,value=0) cara=1 ;& krivka=1 profil=1 nazevsouboru=pickfile(title='Select file with wedges') pripona=strmid(nazevsouboru,strlen(nazevsouboru)-3,3) if pripona eq 'fts' then image=readfits(nazevsouboru) if pripona eq 'tif' then image=read_tiff(nazevsouboru,/unsigned) endif rozmer=size(image) base1=widget_base(base,/column) base11=widget_base(base1,/row) base111=widget_base(base11,/column) oznobr=widget_label(base111,value='Wedges') im=widget_draw(base111,xsize=rozmer(1),ysize=rozmer(2),x_scroll_size=500,y_scroll_size=500,$ /motion_events,/button_events,uvalue='OBR') base112=widget_base(base11,/column) mez1=widget_base(base112,ysize=20) lab1=widget_label(base112,value='range',/align_left) button112=widget_button(base112,value='range for profiles',uvalue='INFO11',xsize=110) mez2=widget_base(base112,ysize=20) lab2=widget_label(base112,value='number of profile',/align_left) ;base12 button1=widget_button(base112,value='1',/menu,xsize=110,/align_left) button11=widget_button(button1,value='1',uvalue='1jedna') button12=widget_button(button1,value='2',uvalue='2jedna') button13=widget_button(button1,value='3',uvalue='3jedna') button14=widget_button(button1,value='4',uvalue='4jedna') button15=widget_button(button1,value='5',uvalue='5jedna') button16=widget_button(button1,value='quiet sun',uvalue='6jedna') mez3=widget_base(base112,ysize=20) lab3=widget_label(base112,value='coordinates',/align_left) button113=widget_button(base112,value='coordinates of region',uvalue='INFO12',xsize=110) ; mez8=widget_base(base112,ysize=20) ; lab8=widget_label(base112,value='grey filter',/align_left) ; button118=widget_button(base112,value='grey filter',uvalue='INFO13',xsize=110) mez4=widget_base(base112,ysize=20) lab4=widget_label(base112,value='spectral line',/align_left) button114=widget_button(base112,value='Halpha',/menu,/align_left,xsize=110) button1141=widget_button(button114,value='Halpha',uvalue='HALFA') button1142=widget_button(button114,value='Hbeta',uvalue='HBETA') button1143=widget_button(button114,value='CaII',uvalue='CAII') button1144=widget_button(button114,value='CaK',uvalue='CAK') button1145=widget_button(button114,value='CaH',uvalue='CAH') ;******************* ;widget_control,button1143,sensitive=0 mez5=widget_base(base112,ysize=100) pollab=widget_label(base112,value='position',/align_left) poloha=widget_label(base112,value='position',/frame,xsize=110,/align_left) mez6=widget_base(base112,ysize=20) jaslab=widget_label(base112,value='brightness',/align_left) jas=widget_slider(base112,uvalue='BRI',value=jasnost,min=0,max=50) case cara of 1:widget_control,button114,set_value='Halpha' 2:widget_control,button114,set_value='Hbeta' 3:widget_control,button114,set_value='CaII' 4:widget_control,button114,set_value='CaK' 5:widget_control,button114,set_value='CaH' ;************************* endcase mez7=widget_base(base11,xsize=50) base113=widget_base(base11,/column) mez7=widget_base(base113,ysize=20) ozn11=widget_label(base113,value='Profile from 1st wedge step') & prof11=widget_draw(base113,xsize=200,ysize=62) ozn12=widget_label(base113,value='Profile from 2nd wedge step') & prof12=widget_draw(base113,xsize=200,ysize=62) ozn13=widget_label(base113,value='Profile from 3rd wedge step') & prof13=widget_draw(base113,xsize=200,ysize=62) ozn14=widget_label(base113,value='Profile from 4th wedge step') & prof14=widget_draw(base113,xsize=200,ysize=62) ozn15=widget_label(base113,value='Profile from 5th wedge step') & prof15=widget_draw(base113,xsize=200,ysize=62) ozn16=widget_label(base113,value='Profile of quiet sun') & prof16=widget_draw(base113,xsize=200,ysize=62) base12=widget_base(base1,/row) dalsi1=widget_button(base12,xsize=100,value='NEXT',uvalue='DRUHA') if zac eq 0 then widget_control,button1,sensitive=0 ;number of profile widget_control,im,get_value=okno & wset,okno tv,bytscl(image)+jasnost if zac2 eq 1 then begin ;pokud navrat tak vykreslit profily for i=0,5 do begin case i of 0:widget_control,prof11,get_value=nastav1 1:widget_control,prof12,get_value=nastav1 2:widget_control,prof13,get_value=nastav1 3:widget_control,prof14,get_value=nastav1 4:widget_control,prof15,get_value=nastav1 5:widget_control,prof16,get_value=nastav1 endcase wset,nastav1 plot,myprofiles(*,i),pos=[0,0,1,1],xstyle=4,ystyle=4 endfor widget_control,button1,set_value='quiet sun' widget_control,button11,sensitive=0 widget_control,button12,sensitive=0 widget_control,button13,sensitive=0 widget_control,button14,sensitive=0 widget_control,button15,sensitive=0 endif jedna=1 & dva=0 & tri=0 & zac=1 END ;--------------------range,coordinates,dispersion,kontinuum,fitting--------- 'INFO11':BEGIN ;range infobase11=widget_base(/column) b11=widget_base(infobase11,/row) & b12=widget_base(infobase11,/row) t11=cw_field(b11,title='1st x position') t12=cw_field(b12,title='2nd x position') okbut11=widget_button(infobase11,value='OK',uvalue='ZAVRI') widget_control,t11,set_value=hranice1 & widget_control,t12,set_value=hranice2 widget_control,infobase11,/realize xmanager,'info11',infobase11 END 'INFO12':BEGIN ;coordinates infobase12=widget_base(/column) ;xsize=600 b13=widget_base(infobase12,/row) & b14=widget_base(infobase12,/row) & b15=widget_base(infobase12,/row) t13=cw_field(b13,title='heliographic longtitude') t14=cw_field(b14,title='heliographic latitude') t15=cw_field(b15,title='latitude of the center of the disk') okbut12=widget_button(infobase12,value='OK',uvalue='ZAVRI') widget_control,t13,set_value=longt & widget_control,t14,set_value=lat widget_control,t15,set_value=center widget_control,infobase12,/realize xmanager,'info12',infobase12 END ;'INFO13':BEGIN ;grey filter ; infobase13=widget_base(/column) ;xsize=600 ; t16=cw_field(infobase13,title='grey filter') ; okbut13=widget_button(infobase13,value='OK',uvalue='ZAVRI') ; widget_control,t16,set_value=grey ; widget_control,infobase13,/realize ; xmanager,'info13',infobase13 ; END 'DISP':BEGIN ;disperse napis1=delka1 napis2=delka2 case cara of 1:begin if (abs(float(delka1)-6562.808) gt 10.0) or (delka1 eq '') then begin napis1='6560.555' & napis2='6562.808' endif end 2:begin if (abs(float(delka1)-4860.0) gt 10.0) or (delka1 eq '') then begin napis1='4859.747' & napis2='4862.598' endif end 3:begin if (abs(float(delka1)-8542.144) gt 10.0) or (delka1 eq '') then begin napis1='8540.817' & napis2='8542.144' ;dodelat endif end 4:begin if (abs(float(delka1)-3930.308) gt 10.0) or (delka1 eq '') then begin napis1='3930.308' & napis2='3935.826' ;napis2='3933.70' endif end 5:begin if (abs(float(delka1)-3968.492) gt 10.0) or (delka1 eq '') then begin napis1='3967.431' & napis2='3969.268' ;********************** endif end endcase dispbase2=widget_base(/column) dis1=widget_base(dispbase2,/row) & dis2=widget_base(dispbase2,/row) ;& dis3=widget_base(dispbase2,/row) cara1=cw_field(dis1,value=napis1,title='lambda1') alfa2=cw_field(dis1,title='position1') cara2=cw_field(dis2,value=napis2,title='lambda2') voda2=cw_field(dis2,title='position2') okbut21=widget_button(dispbase2,value='OK',uvalue='ZAVRI') widget_control,alfa2,set_value=posalfa & widget_control,voda2,set_value=posvoda widget_control,dispbase2,/realize xmanager,'info21',dispbase2 END 'CONT':BEGIN ;kontinuum kontbase2=widget_base(/column) kon1=widget_base(kontbase2,/row) & kon2=widget_base(kontbase2,/row) kont1=cw_field(kon1,title='left x position of continuum') kont2=cw_field(kon2,title='right x position of continuum') okbut22=widget_button(kontbase2,value='OK',uvalue='ZAVRI') widget_control,kont1,set_value=kontinuum1 & widget_control,kont2,set_value=kontinuum2 widget_control,kontbase2,/realize xmanager,'info22',kontbase2 END 'MINIMIZING':BEGIN ;fitting minbase2=widget_base(/column) zn1=widget_label(minbase2,value='1st region for fitting',/frame,/align_left) minim1=widget_base(minbase2,/row) iksm11=cw_field(minim1,title='left x position') iksm12=cw_field(minim1,title='right x position') zn2=widget_label(minbase2,value='2nd region for fitting',/frame,/align_left) minim2=widget_base(minbase2,/row) iksm21=cw_field(minim2,title='left x position') iksm22=cw_field(minim2,title='right x position') okbut31=widget_button(minbase2,value='OK',uvalue='ZAVRI') widget_control,iksm11,set_value=reg11 & widget_control,iksm12,set_value=reg12 widget_control,iksm21,set_value=reg21 & widget_control,iksm22,set_value=reg22 widget_control,minbase2,/realize xmanager,'info23',minbase2 END ;---------------------------------image------------------------------------ 'OBR': BEGIN ;position of cursor widget_control,poloha,set_value=strcompress('('+string(event.x)+','+ $ string(event.y)+')',/remove_all) ;plotting a profile if (event.press eq 1) and (zac eq 1) and (profil le 6) then begin hr1=fix(hranice1(0)) & hr2=fix(hranice2(0)) ;range if (hr1 ne 0) and (hr2 ne 0) then begin ;pokud zadany range if total(klin) eq 0 then begin myprofiles=make_array(hr2-hr1+1,6,value=0.0) zavedeno=1 ;zavedeno myprofiles ymyprof=make_array(6,value=0) ;y hodnoty profilu endif oblast=image(hr1:hr2,event.y-2:event.y+2) ;oblast pro profil ips=make_array(hr2-hr1+1,value=0) for i=0,4 do ips=ips+float(oblast(*,i)) ips=ips/5 ;prumer profilu myprofiles(*,profil-1)=round(ips) ymyprof(profil-1)=event.y if profil ne 6 then klin(profil-1)=1 ;pokud profil klinu case profil of ;nakresleni profilu 1:widget_control,prof11,get_value=nastav1 2:widget_control,prof12,get_value=nastav1 3:widget_control,prof13,get_value=nastav1 4:widget_control,prof14,get_value=nastav1 5:widget_control,prof15,get_value=nastav1 6:widget_control,prof16,get_value=nastav1 endcase wset,nastav1 plot,ips,pos=[0,0,1,1],xstyle=4,ystyle=4 endif endif END ;---------------------------2nd screen (position)----------------- 'OBR2':BEGIN coord=convert_coord(event.x,event.y,/device,/to_data) ;data coord. iks=round(coord(0)) & ips=round(coord(1)) widget_control,poloha2,set_value=STRCOMPRESS('('+string(iks)+','+string(ips)+')',/rem) END ;--------------------------nahrani druhe obrazovky------------------- 'DRUHA':BEGIN test=1 ;kontrola zda spravne hodnoty coordinates, zda aspon dva klinove ;profily, zda profil klidneho slunce, zda profily poporade if jedna eq 1 then begin ;pokud z prvni obrazovky if zavedeno eq 1 then begin ;je-li zavedeno pole myprofiles ;if (fix(longt(0)) eq 0) or (fix(lat(0)) eq 0) then test=0 ;if (total(myprofiles(*,0)) eq 0) or (total(myprofiles(*,1)) eq 0) or (total(myprofiles(*,5)) eq 0) then test=0 ;if total(klin(0:total(klin)-1)) ne total(klin) then test=0 ;if (fix(longt(0)) gt 90) or (fix(longt(0)) lt -90) or (fix(lat(0)) gt 90) or (fix(longt(0)) lt -90) then test=0 if (total(klin) le 2) or (total(myprofiles(*,5)) eq 0) then test=0 ;mene nez 2 kliny nebo neni klidny slunce if (fix(longt(0)) gt 90) or (fix(longt(0)) lt -90) or (fix(lat(0)) gt 90) or (fix(longt(0)) lt -90) then test=0 if (center(0) eq '') or (longt(0) eq '') or (lat(0) eq '') then test=0 ;zadne hodnoty ; if (grey(0) eq '') then test=0 endif else test=0 endif if test eq 1 then begin ;pokud v poradku, nahraj druhou obrazovku if jedna eq 1 then widget_control,base1,/destroy ;z prvni obrazovky if tri eq 1 then widget_control,base3,/destroy ;z druhy obrazovky if (dva eq 0) then begin zac2=1 base2=widget_base(base,/column) base21=widget_base(base2,/row) dr12=widget_draw(base21,xsize=700,ysize=500,/motion_events,uvalue='OBR2') base23=widget_base(base21,/column) displab=widget_label(base23,value='dispersion curve',/align_left) disp=widget_button(base23,value='position of lines',uvalue='DISP',xsize=110) dispmez=widget_base(base23,ysize=20) kontlab=widget_label(base23,value='continuum',/align_left) kont=widget_button(base23,value='position of continuum',uvalue='CONT',xsize=110) kontmez=widget_base(base23,ysize=20) minimlab=widget_label(base23,value='fitting',/align_left) minim=widget_button(base23,value='regions for fitting',uvalue='MINIMIZING',xsize=110) minimmez=widget_base(base23,ysize=20) ;krlab=widget_label(base23,value='characteristic curve',/align_left) ;krbut=widget_button(base23,value='exponential',/menu,/align_left,xsize=110) ; krbut1=widget_button(krbut,value='linear',uvalue='kr1') ; krbut2=widget_button(krbut,value='polynomial (2)',uvalue='kr2') krmez=widget_base(base23,ysize=270) ;220 poloha2lab=widget_label(base23,value='position',/align_left) poloha2=widget_label(base23,value='position',/frame,xsize=110,/align_left) base22=widget_base(base2,/row) prev2=widget_button(base22,value='PREVIOUS',uvalue='START1') next2=widget_button(base22,value='CALIBRATE',uvalue='TRETI') ;case krivka of ;1:widget_control,krbut,set_value='linear' ;2:widget_control,krbut,set_value='polynomial (2)' ;endcase widget_control,dr12,get_value=nastav2 & wset,nastav2 indexy=where(klin) plot,smooth(myprofiles(*,indexy(0)),2) ;profil prvniho klinu endif tri=0 & jedna=0 & dva=1 endif else begin ;ohlaseni chyb chyba1=widget_base(/column) mez11=widget_base(chyba1,ysize=10) chyba11=widget_label(chyba1,value='Missing some information') chyba12=widget_label(chyba1,value='or data incorrect!') mez12=widget_base(chyba1,ysize=10) widget_control,chyba1,/realize wait,2 widget_control,chyba1,/destroy endelse END ;-------------------------------nahrani treti obrazovky--------------------- 'TRETI':BEGIN test=1 ;neni zadane if (fix(posvoda(0)) eq 0) or (fix(posalfa(0)) eq 0) then test=0 if (fix(kontinuum1(0)) eq 0) or (fix(kontinuum2(0)) eq 0) then test=0 if (fix(reg11(0)) eq 0) or (fix(reg12(0)) eq 0) or (fix(reg21(0)) eq 0) or (fix(reg22(0)) eq 0) then test=0 s=size(myprofiles) ;neni v poli myprofiles if (fix(posvoda(0)) lt 0) or (fix(posvoda(0)) gt s(1)) then test=0 if (fix(posalfa(0)) lt 0) or (fix(posalfa(0)) gt s(1)) then test=0 if (fix(kontinuum1(0)) lt 0) or (fix(kontinuum1(0)) gt s(1)) then test=0 if (fix(kontinuum2(0)) lt 0) or (fix(kontinuum2(0)) gt s(1)) then test=0 if (fix(reg11(0)) lt 0) or (fix(reg11(0)) gt s(1)) then test=0 if (fix(reg12(0)) lt 0) or (fix(reg12(0)) gt s(1)) then test=0 if (fix(reg21(0)) lt 0) or (fix(reg21(0)) gt s(1)) then test=0 if (fix(reg22(0)) lt 0) or (fix(reg22(0)) gt s(1)) then test=0 ;prehozene hodnoty if (fix(posalfa(0)) ge fix(posvoda(0))) or (fix(kontinuum1(0)) ge fix(kontinuum2(0))) then test=0 if (fix(reg11(0)) ge fix(reg12(0))) or (fix(reg12(0)) ge fix(reg21(0))) then test=0 if (fix(reg21(0)) ge fix(reg22(0))) then test=0 if test eq 1 then begin zac3=1 & tri=1 & dva=0 & jedna=0 widget_control,base2,/destroy base3=widget_base(base,/column) ;disperse disp1=make_array(2,/float) & disp2=make_array(2,/float) disp2(0)=fix(posalfa(0)) & disp2(1)=fix(posvoda(0)) disp1(0)=float(delka1) & disp1(1)=float(delka2) ;disperze result=poly_fit(double(disp2),disp1,1) coef=dblarr(2) & coef(0)=result(0) & coef(1)=result(1) case cara of 1:begin ;disp1(0)=6560.555 & disp1(1)=6562.808 tabulka='halpha.tab' end 2:begin ;disp1(0)=4859.747 & disp1(1)=4862.598 tabulka='hbeta.tab' end 3:begin ;disp1(0)=8540.817 & disp1(1)=8542.144 tabulka='caii.tab' end 4:begin tabulka='cak.tab' end 5:begin tabulka='cah.tab' ;******************** end endcase ;kontinuum cont=make_array(2,/int) & cont(0)=fix(kontinuum1(0)) & cont(1)=fix(kontinuum2(0)) ;vstupni pole pro clb_curv myprofiles1=make_array(s(1),total(klin)+1) myprofiles1(*,0:total(klin)-1)=myprofiles(*,where(klin)) ;kliny myprofiles1(*,total(klin))=myprofiles(*,5) ;klidne slunce ;oblasti minimalizace reg=make_array(2,2,/int) reg(0,0)=fix(reg11(0)) & reg(0,1)=fix(reg21(0)) & reg(1,0)=fix(reg12(0)) & reg(1,1)=fix(reg22(0)) tab=get_tab(tabulka,float(center(0)),fix(longt(0)),fix(lat(0))) clb_curv,myprofiles1,a,reg,Id_klin=klin endif else begin ;ohlaseni chyb chyba2=widget_base(/column) mez21=widget_base(chyba2,ysize=10) chyba21=widget_label(chyba2,value='Missing some information') chyba22=widget_label(chyba2,value='or data incorrect!') mez22=widget_base(chyba2,ysize=10) widget_control,chyba2,/realize wait,2 widget_control,chyba2,/destroy endelse END ;-----------------------brightness-------------------- 'BRI':begin widget_control,jas,get_value=jasnost widget_control,im,get_value=nastavjas wset,nastavjas & tv,bytscl(image)+jasnost end ;-----------------------spectral line------------------ 'HALFA':begin widget_control,button114,set_value='Halpha' cara=1 end 'HBETA':begin widget_control,button114,set_value='Hbeta' cara=2 end 'CAII':begin widget_control,button114,set_value='CaII' cara=3 end 'CAK':begin widget_control,button114,set_value='CaK' cara=4 end 'CAH':begin widget_control,button114,set_value='CaH' cara=5 end ;*************************** ;----------------------store number of profile to variable profil------ ELSE:begin widget_control,event.id,get_value=pom widget_control,widget_info(event.id,/parent),set_value=pom(0) cisloprofilu=fix(strmid(uvalue,0,1)) profil=cisloprofilu if profil eq 6 then begin ces=pickfile(title='Select file with image') nazevsouboru=ces pripona=strmid(nazevsouboru,strlen(nazevsouboru)-3,3) imageklin=image if pripona eq 'fts' then image=readfits(nazevsouboru) if pripona eq 'tif' then image=read_tiff(nazevsouboru,/unsigned) widget_control,oznobr,set_value='Image' widget_control,im,/destroy rozmer=size(image) im=widget_draw(base111,xsize=rozmer(1),ysize=rozmer(2),x_scroll_size=500,y_scroll_size=500,$ /motion_events,/button_events,uvalue='OBR') widget_control,im,get_value=okno wset,okno & tv,bytscl(image)+jasnost hor=fix(hranice2(0)) if (hor ge rozmer(1)) then begin ;pokud je rozsah pro profil vesti nez velikost 2. obrazku chyba=widget_base() chlab=widget_label(chyba,value='The range is out of image. Try again with another range.') widget_control,chyba,/realize endif widget_control,button11,sensitive=0 widget_control,button12,sensitive=0 widget_control,button13,sensitive=0 widget_control,button14,sensitive=0 widget_control,button15,sensitive=0 endif end ENDCASE END ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;--------------------------calib--------------------------------- PRO fotocalib_disk COMMON udaje12,t13,t14,longt,lat,t15,center COMMON udaje23,iksm11,iksm12,iksm21,iksm22,reg11,reg12,reg21,reg22 COMMON udaje22,kont1,kont2,kontinuum1,kontinuum2 COMMON udaje21,voda2,alfa2,posvoda,posalfa COMMON vse,base,poloha,zac,im,zac2,w2,g1,zac3,jedna,dva,tri,basepoc,f1 COMMON udaje11,t11,t12,hranice1,hranice2 zac=0 & hranice1='' & hranice2='' & zac2=0 & zac3=0 posvoda='' & posalfa='' & kontinuum1='' & kontinuum2='' reg11='' & reg12='' & reg21='' & reg22='' & longt='' & lat='' jedna=0 & dva=0 & tri=0 & center='' base=widget_base(title='CALIB',xsize=940,ysize=650,/row,mbar=bar) fmenu=widget_button(bar,value='FILE',/menu) f1=widget_button(fmenu,value='LOAD',uvalue='START1') f2=widget_button(fmenu,value='QUIT',uvalue='QUIT') basepoc=widget_base(base,xsize=970,ysize=650) vstup=widget_button(basepoc,value='ENTER',uvalue='START1',xsize=970,ysize=650) WIDGET_CONTROL,base,/REALIZE widget_control,f1,sensitive=0 XMANAGER,'fotocalib',base END