;##################################################################
;# this program developed for RATAN-600 data comparison with #
;# FITS data from Nobeyama, SSRT, SOHO MDI etc #
;# copyright Solar Group                   #
;# by Susanna Tokhchukova, susan@sao.ru            #
;# May 2002                    #
;##################################################################
;dannaya programma prednaznachena dlja prosmotra 2D FITS failov f standarte SOHO fits
;(Nobeyama, SSRT, SOHO MDI), vypolenija prostyh operacij nad massivami
;i predstavlenija izobrazhenij v razlichnyh vidah (konturi, cvet, 3D etc)
;a takzhe dlja svertki s 2D DNA RATAN-600 i zapisi v format WorkScan FITS
;dlja detalnogo sopostavlenija s dannimi RATAN-600 v programme WorkScan
;some menu items:
;View->Flux :
;View->Filtr : priravnivaet k nulju elementy massiva men'she x*max
;View->Divide by..  : delit ves massiv na zadannoe chislo x
;Image_man-> Rotate: povernut' image po chasovoj strelke (so znakom minus) ili protiv
; chasovoj strelki na pozicionnyj ugol, znachenie kotorogo vvoditsja vruchnuju,
; i beretsja iz shapki dannyh RATAN-600 na tot zhe den
;esli okno s izobrazheniem ne obnovljaetsja (ne vidno povorota), vybrat menu View-> Image type-> Image
;Image_man-> 2D->1D : svernut s vertikalnoj DNA RATAN-600 i zapisat v fail s okonchaniem _i
;Image_man-> 2D->RATAN : svernut s vertikalnoj i gorizontalnoj DNA RATAN-600 i
; zapisat v fail s okonchaniem i (bez podcherkivanija)
; Image_man-> Oplot
;esli chastota (pole OBS-FREQ v FITS header) ne popadaer v radiodiapazon
;ili takoj parametr v header otsutstvuet, ego znachenie prinimaetsja ravnim 20GHz v
; funkcii 2D->1D i 21GHz v funkcii 2D->RATAN

pro fitsrat768
device,decomp=0
loadct,0;27;EOS B
sigma=580.& wtitle='FITSRAT'
sigma=1629.0
;naxis1=894&naxis2=894& str=0&str1=0&str2=0
xs=512+256
ys=512+256
naxis1=xs&naxis2=xs& str=0&str1=0&str2=0
x=0&cdelt1=0.0 &header=0
fl_file=0 & fl_rt=1
;CD, 'c:\susandata-synoptic'
chislo=6000
zeroo_obnul=1
zeroo=-32768
itype=1
xtimes=4

base1 = WIDGET_BASE(TITLE=wtitle,/COLUMN)
items = ['"File"{','"Open"','"View_GIF"','"Write_GIF"','"Write_FITS"','"Quit"','"Contour_Overplot"','}',$
'"Calc"{','"Flux"','"Divide by.."','}',$
'"View"{','"Header"','"Zoom fact 4"','"Zoom interp fact 4 size 400"','"Color"','}',$
'"Image type"{','"Image"','"TVCON"','"Contour overlay"','"Contour"','"Contour_levels"','"Plot"','"Shaded"','"Full"','"Slade_im"','}',$
'"Image_man"{','"Filtr"','"Rotate"','"Rotate interp"','"2D->1D"','"2D->RATAN"','"Oplot"','"Annotate"','}'$
,'"FITS"{','"Scale"','"Unscale"','}']
xpdmenu,items,base1
wtxt=widget_label(base1,value='No file open',/FRAME,/DYNAMIC_RESIZE)
base = WIDGET_BASE(base1,TITLE=wtitle,/ROW)
drw =WIDGET_DRAW(base,xsize=naxis1,ysize=naxis2, X_SCROLL_SIZE=xs, Y_SCROLL_SIZE=xs,  uvalue='mousedraw',/MOTION_EVENTS,/SCROLL)
;list = WIDGET_LIST(base, VALUE ='NULL', UVALUE = 'LIST', XSIZE =50,/FRAME )

widget_control, /REALIZE, base1

;line 20***********main cycle**********
znachenie=''
repeat begin
sobytie = widget_event(base1)
WIDGET_CONTROL, get_uvalue=znachenie, sobytie.id
if (fl_file eq 0) and (znachenie ne 'Open') then goto,konec
case znachenie of
'mousedraw': if itype AND telescop ne 'RATAN-600' then begin
      text=strcompress(string('x=',FIX((sobytie.x-naxis1/2)*cdelt1),'"  y=',FIX((sobytie.y-naxis2/2)*cdelt2),' "  z=',str(sobytie.x,sobytie.y)))
      ;text=strcompress(string('x=',FIX((sobytie.x-naxis1/2)),' y=',FIX((sobytie.y-naxis2/2)),' z=',str(sobytie.x,sobytie.y)))
       widget_control,wtxt,set_value=text
       goto, konec
       endif else goto, konec
'Quit': goto,konec
'Open': begin
itype=1
       ;nfile=pickfile(/READ,FILTER='*.*');,file='fd_M_96m_01d_3007_0006.fit');fit');.fts'); *.0?? *.fts *.fits')
       fits = ['*.0??', '*.fts', '*.fits']
       nfile = DIALOG_PICKFILE(TITLE='choose FITS file',GET_PATH=new_dir,FILTER=fits); ile='1999_10_20i.fit',FILTER='*.fit')
nfile=strmid(nfile,strlen(new_dir), strlen(nfile))
cd, new_dir
       if nfile eq '' then goto,konec
       fl_file=1 & telescop='unknown'
       str=mrdfits(nfile,0,header,/fscale)
       header0=header
       date_obs=fxpar(header,'DATE-OBS')
       IF date_obs eq 0 then  date_obs=fxpar(header,'DATE_OBS')
print,date_obs
       instrume=strcompress(fxpar(header,'INSTRUME'), /REMOVE_ALL)
       ;if instrume EQ 'EIT' then date_obs=fxpar(header,'DATE')
       time_obs=fxpar(header,'TIME-OBS')
       if time_obs eq 0 then time_obs='12:10:00.000'
       object=fxpar(header,'OBJECT')
       print, object

       if object eq '       0' then begin object='SUN'
          print, object
       fxaddpar, header, 'OBJECT', object, 'GHz, added by idl'
       endif

       ang=0
       ang=fxpar(header,'SOLP')
       if ang eq 0 then ang=fxpar(header,'ANGLE')
       naxis1=fxpar(header,'NAXIS1')
       naxis0=naxis1
       naxis2=fxpar(header,'NAXIS2')
       cdelt1=fxpar(header,'CDELT1')
       cdelt2=fxpar(header,'CDELT2')
       bzero=fxpar(header,'BZERO')
       bscale=fxpar(header,'BSCALE')
       freq='qq'
       freq=float(fxpar(header,'OBS-FREQ'))
       telescop=strcompress(fxpar(header,'TELESCOP'), /REMOVE_ALL)
       print, telescop
       print, freq
       if telescop eq 'SSRT' and freq NE 5.7 then begin
       freq=float(strcompress(strmid(freq,0,strpos(freq,'G')),/remove_all))
       fxaddpar, header, 'OBS-FREQ', freq, 'GHz, added by idl'
       end
       print, freq
if telescop EQ 'SOHO' or telescop EQ 'THEMIS' then begin
zeroo=str(5)
if instrume EQ 'EIT' then zeroo_obnul=0
if zeroo_obnul eq 1 then begin
iii=where(str eq zeroo, nnn)
if nnn NE 0 then str(iii)=0
endif
endif
       mmax=max(str, imax)
       ximax=(imax mod naxis1)
       yimax=imax/naxis1
       mmin=min(str, imin)
       ximin=imin mod naxis1
       yimin=imin/naxis1

;help,str
print, date_obs, '  ', time_obs
       dat=date_obs
    if  strpos(dat,'\') NE -1 then dt = STR_SEP(dat, '\')
    if  strpos(dat,'_') NE -1 then dt = STR_SEP(dat, '_')
    if  strpos(dat,'-') NE -1 then dt = STR_SEP(dat, '-')
    if  strpos(dat,'/') NE -1 then dt = STR_SEP(dat, '/')
    print, dt[2]
    if strlen(dt[2]) gt 3 then time_obs=strmid(dt[2],3,strlen(dt[2]))
    dt[2]=strmid(dt[2],0,2)
    dat=dt[0]+dt[1]+dt[2]
       if telescop eq 'SSRT'  then begin
       if dt[2] EQ 1900 then DT.year=2000;DT.year+100
       dat=dt[0]+dt[1]+dt[2]
       print, dat
       endif

 time_obs=fxpar(header,'TIME-OBS')
       if time_obs eq 0 then time_obs='12:10:00.000'
       ttm=time_obs
       print,time_obs
    if  strpos(ttm,'\') NE -1 then ttt = STR_SEP(ttm, '\')
    if  strpos(ttm,'_') NE -1 then ttt = STR_SEP(ttm, '_')
    if  strpos(ttm,'-') NE -1 then ttt = STR_SEP(ttm, '-')
    if  strpos(ttm,'/') NE -1 then ttt = STR_SEP(ttm, '/')
    if  strpos(ttm,':') NE -1 then ttt = STR_SEP(ttm, ':')
    ttime=ttt[0]+ttt[1];+strcompress(string(round(float(ttt[2]))),/REMOVE_ALL)
    iv_type=strupcase(strcompress(fxpar(header,'POLARIZ'),/REMOVE_ALL))
    if iv_type EQ 'R-L' then tt='v' else tt='i'
    ftname=new_dir+dat+'_'+ttime+tt+'.fit'
    print,ftname

if telescop EQ 'SOHO' then begin

if naxis1 GT xs then begin
mmax=max(str, imax)
       ximax=imax mod naxis1
       yimax=imax/naxis1
mmin=min(str, imin)
       ximin=imin mod naxis1
       yimin=imin/naxis1

;help,str
print, 'bscale=', bscale, '   bzero=',bzero
print, 'naxis1=', naxis1
print, 'after scaling (',STRTRIM(naxis1,2),' x ',STRTRIM(naxis2,2), '): max(str)=',mmax,strcompress(' ('+string(ximax)+';'+string(yimax)+')'),$
yimax, ' min(str)=', mmin, strcompress(' ('+string(ximin)+';'+string(yimin)+')')

;str = rot(str, 0., (sxpar(header, 'earth_r0')/sxpar(header, 'r_sun'))/cdelt1, $
;   sxpar(header, 'crpix1'), sxpar(header, 'crpix2'), /int, miss = 0)

;mdi_size=size(str)
;naxis1=mdi_size[1]
print, 'OLD CDELT1 IS',cdelt1
str=congrid(str, xs,ys)
print, 'xs=', xs
ss=naxis1*1.0/xs
naxis2=naxis1
;if ss ne 1 then begin
cdelt1=cdelt1*ss
cdelt2=cdelt2*ss
print, 'IMAGE WAS RESIZED  BY FACTOR',ss
print, 'NEW CDELT1 IS',cdelt1
fxaddpar, header, 'CDELT1', cdelt1, 'GHz, added by idl'

;27 jul 2006
if instrume EQ 'EIT' then begin
solar_r=fxpar(header,'SOLAR_R')
fxaddpar, header, 'SOLAR_R', solar_r/ss, 'GHz, added by idl'
end
;--27jul 2006

end
naxis1=xs
naxis2=ys
endif

;endif

mmax=max(str, imax)
ximax=imax mod naxis1
yimax=imax/naxis1
mmin=min(str, imin)
ximin=imin mod naxis1
yimin=imin/naxis1

;help,str
print, 'after rebin to (', STRTRIM(xs,2), ' x ', STRTRIM(ys,2), ') : max(str)=',mmax,strcompress(' ('+string(ximax)+';'+string(yimax)+')'),$
' min(str)=', mmin, strcompress(' ('+string(ximin)+';'+string(yimin)+')')

      if telescop eq '' then telescop='unknown'
case telescop of
'150 ft': begin
       cdelt1=fxpar(header,'DXB_IMG')
       cdelt2=fxpar(header,'DYB_IMG')
       end
'VACUUM TELESCOPE': begin
    cdelt1=fxpar(header,'SCALE')
    cdelt2=fxpar(header,'SCALE')
    time_obs=fxpar(header,'UTSTART')
    date_obs=fxpar(header,'UTDATE')
    naxisn1=xs
    naxisn2=ys
       end
'RATAN-600':  begin
       ;str= float(REFORM(str, naxis1, naxis2, /OVERWRITE))
       ;str=str-min(str)
       ;str=(str/max(str))*256
       end
'radioheliograph': begin
       end
'unknown': begin
       ; cdelt1=fxpar(header,'DXB_IMG')
       cdelt1=4.92
       cdelt2=4.92
       end
 else:
endcase

;-------risovanie titla i headera

;x=(findgen(naxis1)- fix(naxis1/2))*cdelt1
wtitle=strupcase(STRCOMPRESS(object+date_obs+'/'+time_obs+'UT'))
widget_control,wtxt,set_value=wtitle
;widget_control,list,set_value=header
tvscl,str
end
'View_GIF':begin
       gif_file=pickfile(/READ);,FILTER='C:\users\susan\nobeyama\*.gif')
       if gif_file eq '' then goto,konec
       READ_GIF, gif_file, Image,R,G,B
       erase
       TVLCT, R, G, B
       tv,Image
       goto, konec
end


'Color': begin
;str=str*256/(max(str)-min(str))
;tvscl,str
        xloadct;, /modal,  block=1, group=base1, /modal, /silent=1; & goto,kon
 ;       tvscl,str
        end
 'Filtr':begin
 str2=str
 str=str2
 mmax=max(str, min=mmin)
 mlevel=0.5
  xvaredit,mlevel
  mcut=mmax*mlevel
  ;mcut=500
  ;str=smooth(str,5)
  for k=0,naxis1-1 do begin
 for kk=0,naxis1-1 do  begin
 ;if (str(k,kk) LT mmax/5) OR (str(k,kk) LT mmax/5) then str(k,kk)=0
 if (ABS(str(k,kk)) LT mcut)  then str(k,kk)=0
 endfor
 endfor
 str=smooth(str,3)
 end
 'Divide by..':begin
 divid=2
 print, 'max(str)=',max(str)
 xvaredit,divid
 str=str/divid
 tvscl,str
print, 'max(str)=', max(str)
 end

'Zoom fact 4': begin
        widget_control,wtxt,set_value='Right button for Quit'
        dat='20011219'
        wlss='1_76'
        xtimes=2

        zoom_az_su, wlss=wlss, dat1=dat, massiv=str, xtimes=xtimes,FACT=4,xsize=200,ysize=200, cdelt=cdelt1;,/interp;/xtimes
       ;zoom ,FACT=8,xsize=400,ysize=400,/INTERP,/KEEP,/NEW_WINDOW
       ; cw_zoom,base1
;        ,set_value=str
       end

  'Zoom interp fact 4 size 400': begin
        widget_control,wtxt,set_value='Right button for Quit'
        dat='20011219'
        wlss='1_76'
        xtimes=2
        zoom_az_su, wlss=wlss, dat1=dat, massiv=str, xtimes=xtimes,FACT=4,xsize=400,ysize=400,/interp, cdelt=cdelt1;/xtimes
       ;zoom ,FACT=8,xsize=400,ysize=400,/INTERP,/KEEP,/NEW_WINDOW
       ; cw_zoom,base1
;        ,set_value=str
       end
'Flux': begin
        xsz=130;
        help, wlss ,OUTPUT=aa
if aa[0] eq 'WLSS            UNDEFINED = <Undefined>' then wlss='0_00'
                ;xvaredit, xsz;
        ;print, date_obs
        ;print, 'max(str=)', max(str)
        widget_control,wtxt,set_value='Right button for Quit'
       ; zoom_my, massiv=str, FACT=4,xsize=xsz,ysize=xsz,/INTERP,/NEW_WINDOW;, /KEEP
         zoom_az, wlss=wlss, dat1=dat, massiv=str, xtimes=xtimes,FACT=1,xsize=200,ysize=200,/interp;/
        ;zoom ,FACT=4,xsize=200,ysize=200,/INTERP,/KEEP,/NEW_WINDOW
        end
'Contour_area':begin
     xsz=100;200;
        xvaredit, xsz;
        widget_control,wtxt,set_value='Right button for Quit'
        zoom_my, massiv=str, area=b,  FACT=2,xsize=xsz,ysize=xsz,/INTERP,/KEEP,/NEW_WINDOW

        writefits, 'aa.fit',b;,header
end
'Image': begin
tvscl,str
itype=1
end
'TVCON': begin
tvcon, (magpower(str, 0.3))
itype=0
end
'Contour': begin
contour, str
itype=0
end
'Plot':begin
 plot, str
 itype=0
 end
'Shaded': shade_surf,str
'Full':tv, congrid(str, xs,ys),ORDER=1
'Not Scaled': begin
   if telescop eq 'RATAN-600' then begin
   plot,x, str(*,0)
   oplot,x,str(*,1)
   if fl_file eq 2 then oplot,x2,str2
   endif else tv,str
   end
;'Scaled':IMAGE_CONT, str
'Slade_im':slide_image,str
'Contour_levels':begin
contour,str, YTITLE='Ta', xstyle=1, ystyle=1, NLEVELS=10, /FILL
;contour,str, nlevels=10, C_ANNOTATION=10, /overplot
end
'Contour overlay':IMAGE_CONT, str
'2D->1D': begin
itype=0
    ;telescop=strcompress(fxpar(header,'TELESCOP'), /REMOVE_ALL)
       struct= float(REFORM(str, naxis1, naxis2, /OVERWRITE))
       struct1=struct
       x=(findgen(naxis1)- fix(naxis1/2))*cdelt1
       ;sigma=1629.0
       sigma=10000.0
       gauss=exp(-(x/sigma)^2)
       for i=0,511 do struct1(*,i)=gauss(i)*struct(*,i)
       for i=0,511 do struct(i,0)=total(struct1(i,*))/xs
       scan=fltarr(naxis1,2)
       scan(*,0)=struct(*,0)
       scan(*,1)=struct(*,0)
       if max(scan)  lt 100 then scan=scan*300
       ;freq=fxpar(header,'OBS-FREQ')
              print, freq
if freq EQ 0 or FREQ eq 20 then freq=21
fxaddpar, header, 'OBS-FREQ', freq, 'GHz, added by idl'
ftname=new_dir+dat+'_'+ttime+'_'+tt+'.fit'
    writefits, ftname,scan,header
    widget_control,list,set_value=header
      plot, scan(*,1),background=1,TITLE=date_obs +'/'+telescop, xtitle='pixels',$
       YTITLE='Ta', XRANGE=[0,naxis1],YRANGE=[MIN(scan),1.1*MAX(scan)],/XSTYLE
       yshift=median(scan(*,0))/2
   if fl_file eq 2 then oplot,x2,str2
   rat_i_v, dat=dat,telescop=telescop,instrume=instrume,freq=freq,ftname=ftname
    end
'2D->RATAN': begin
itype=0
    telescop=strcompress(fxpar(header,'TELESCOP'), /REMOVE_ALL)
       ;if telescop ne 'radioheliograph' then goto,kon
       struct= float(REFORM(str, naxis1, naxis2, /OVERWRITE))
       struct1=struct
       x=(findgen(naxis1)- fix(naxis1/2))*cdelt1
       if telescop EQ 'radioheliograph' then sigma=580.0
       if telescop EQ 'SSRT' then sigma=1629.0

wl=30.0/freq
       if telescop EQ 'SOHO' then begin
       xvaredit,wl,name='wavelength in cm'
       end
freq=10+30.0/wl
       wl=wl*10.0
       theta_hor=0.85*wl/2
       theta_ver=0.75*wl*60.0/2
       sigma=theta_ver
       maxh=25;xs
       xh=findgen(maxh)
       xh=(xh-fix(maxh/2)+1)*cdelt1
       beamhor=exp(-(xh/theta_hor)^2)
       ;xvaredit,sigma

       gauss=exp(-(x/sigma)^2)
       for i=0,511 do struct1(*,i)=gauss(i)*struct(*,i)
       for i=0,511 do struct(i,0)=total(struct1(i,*))/xs


       ;str(*,0)=str(*,0)-min(str(*,0))
       ;str(*,0)=((str(*,0))/max(str(*,0)))*256
       ;if max(str) GT 30000.0 then str(*,0)=(str(*,0)/max(str(*,0)))*30.000
       ;if max(str) GT 30000.0 then
       ;str(*,0)=str(*,0)/100.0
       scan=fltarr(naxis1,2)
       scan(*,0)=struct(*,0)
       scan(*,1)=struct(*,0)
scan(*,1)=convol(scan(*,1),beamhor)
scan(*,0)=convol(scan(*,0),beamhor)
if max(scan)  lt 100 then scan=scan*300


ftname=new_dir+dat+'_'+ttime+tt+'.fit'
    if freq EQ 0 OR freq EQ 21 then freq=20

    fxaddpar, header, 'OBS-FREQ', freq, 'GHz, added by idl'
    fxaddpar, header, 'CDELT1', cdelt1, 'GHz, added by idl'
    print, ftname
    writefits, ftname,scan,header
rat_i_v, dat=dat,telescop=telescop,instrume=instrume,freq=freq,ftname=ftname
    widget_control,list,set_value=header
  plot, scan(*,1),background=1,TITLE=date_obs +'/'+telescop, xtitle='pixels',$
       YTITLE='Ta', XRANGE=[0,naxis1],YRANGE=[MIN(scan),1.1*MAX(scan)],/XSTYLE
       yshift=median(scan(*,0))/2
   if fl_file eq 2 then oplot,x2,str2

end

'Oplot':begin
       nfile=pickfile(/READ,FILTER='*.0??')
       if nfile eq '' then goto,konec
       fl_file=2
       str2=mrdfits(nfile,0,header2,/fscale)
       naxis12=fxpar(header2,'NAXIS1')
       naxis22=fxpar(header2,'NAXIS2')
       cdelt12=fxpar(header2,'CDELT1')
       cdelt22=fxpar(header2,'CDELT2')
       x2=(findgen(naxis12)-fix(naxis12/2))*cdelt12
       telescop=fxpar(header2,'TELESCOP')
       if telescop ne 'RATAN-600' then goto, konec
       str2= FLOAT(REFORM(str2, naxis12, naxis22, /OVERWRITE))
       str2=str2-min(str2)
       str2=(str2/max(str2))*256
       end
'Contour_Overplot':begin
nfile2=pickfile(/READ,FILTER='*.fit')
       if nfile2 eq '' then goto,konec
       fl_file=2
       str2=mrdfits(nfile2,0,header2,/fscale)
       naxis12=fxpar(header2,'NAXIS1')
       naxis22=fxpar(header2,'NAXIS2')
       cdelt12=fxpar(header2,'CDELT1')
       cdelt22=fxpar(header2,'CDELT2')
       ;x2=(findgen(naxis12)-fix(naxis12/2))*cdelt12
       telescop=fxpar(header2,'TELESCOP')
       ;if telescop ne 'RATAN-600' then goto, konec
       if (naxis1 NE naxis12) then str2= CONGRID(str2, naxis1, naxis2)
       str2=str2-min(str2)
       str2=(str2/max(str2))*256.0
       ;contour,str2, YTITLE='Ta', xstyle=1, ystyle=1, NLEVELS=5, /FILL
        contour,str2, nlevels=5, C_ANNOTATION=5, /overplot
      end

'Annotate': begin
       annotate & goto,konec
       end
'Write_GIF': begin
        nfile=pickfile(FILTER='*.gif')
       if nfile eq '' then goto,konec
        out=bytscl(TVRD())
       tvlct,r,g,b,/get
write_gif,nfile,out,r,g,b
writefits,'tmp.fit',str
       ;IMG=TVRD()
       ;WRITE_GIF, nfile, IMG;byte(str)
       end
       'Write_FITS':begin
        nfile=pickfile(FILTER='*.fit')
       if nfile eq '' then goto,konec
        out=bytscl(TVRD())
       tvlct,r,g,b,/get
;write_gif,nfile,out,r,g,b
fxaddpar, header, 'ANGLE', ang, 'frequency  /idl2'
writefits,nfile,str, header
       end

'Rotate': begin
       XVAREDIT,ang
       ang=-ang ;anticlockwise??
       str=rot(str,ang,/int)& fl_rt=0
 ;      end
 tvscl,str
itype=1
       end
       'Rotate interp': begin
       XVAREDIT,ang
       ang=-ang ;anticlockwise??
       str=rot(str,ang,/INTERP)& fl_rt=0
 ;      end
 tvscl,str
itype=1
       end
'Header': begin
		listitems=header
       if fl_file eq 2 then listitems=header2
       base2 = WIDGET_BASE(TITLE=wtitle,/COLUMN)
       list = WIDGET_LIST( base2, VALUE ='NULL', UVALUE = 'LIST', XSIZE =80, ysize=60, /FRAME )
	   widget_control, /REALIZE, base2
       widget_control, list, set_value=listitems

       end
'Scale': begin
       strun=str
       str=str*bscale+bzero;preobrazovanie k rel'nym velichinam
        end
'Unscale': begin
       str=strun;*bscale+bzero;preobrazovanie k rel'nym velichinam
        end

else: goto,konec
endcase

konec:
end until znachenie eq 'Quit'
WIDGET_CONTROL, /destroy, base1
end
;----------------------------------------------------------------
;#############################################################
pro rat_i_v, dat=dat, telescop=telescop, instrume=instrume,freq=freq,ftname=ftname
if telescop NE 'SOHO' then begin
 mydir = DIALOG_PICKFILE(/DIRECTORY,TITLE='choose dir 2*i.fit and 2*v.fit scans',GET_PATH=new_dir,FILTER='*.fit')
cd, mydir
ifiles=FINDFILE(mydir+'2*i.fit')
vfiles=FINDFILE(mydir+'2*v.fit')
endif else begin
CD, 'C:\', CURRENT=mydir
cd,mydir
print, mydir
mydir=mydir+'\'
ifiles=ftname;
vfiles=ftname;
endelse
vtfiles=vfiles
nfiles=n_elements(ifiles)
close,1

hfile=strcompress(telescop,/REMOVE_ALL);'nob'
if telescop EQ 'SOHO' then hfile=strcompress(instrume,/REMOVE_ALL)
hfile=hfile+dat
openw, 1, hfile+'.0hd'

if vfiles(0) EQ '' then vfiles=ifiles&vtfiles=ifiles

for im=0, nfiles-1 do begin
date_i=strmid(ifiles(im),strlen(mydir), strlen(ifiles(im))-strlen(mydir)-5)
for i=0, nfiles-1 do begin
date_v=strmid(vfiles(i),strlen(mydir), strlen(vfiles(i))-strlen(mydir)-5)
if date_i EQ date_v then vtfiles (im)=vfiles(i)
endfor
endfor
vfiles=vtfiles

naxis1=xs
scan=fltarr(naxis1,nfiles)
pol=fltarr(naxis1,nfiles)
scanw=intarr(naxis1,2)

for im=0, nfiles-1 do begin
       ifile=ifiles(im);nfile=pickfile(/READ,FILTER='*.0??',TITLE='Select Binary FITS file')
       vfile=vfiles(im)
       print, ifile, vfile
       if ifile eq '' then goto,kon
       ;istr=readfits(ifile, iheader) ;str=mrdfits(nfile,0,header,/FSCALE) ;scan(*,im)=str(*,0);plot, str(*,0)
       istr=mrdfits(ifile,0,iheader,/fscale)
       header0=iheader
       bscale1=fxpar(iheader,'BSCALE1')
       bscale2=fxpar(iheader,'BSCALE2')

       ;if max(istr) GT 16000 then
       bzero1=min(istr)
       istr=istr-min(istr)
        maxistr=max(istr)
       istr=istr*32000.0/maxistr
       bscale1=maxistr/32000.0

       scan(*,im)=istr(*,0)
       ;vstr=readfits(vfile, vheader)
       vstr=mrdfits(vfile,0,iheader,/fscale)
       ;if max(vstr) GT 100 then

       bscale2=(max(vstr)-min(vstr))/32000.0
       bzero2=min(vstr)
       vstr=(vstr-bzero2)/bscale2

       pol(*,im)=vstr(*,0)
       print, 'max(scan(*,im))',max(scan(*,im)),' ',min(pol(*,im))

freq=float(fxpar(iheader,'OBS-FREQ'))
instrume=fxpar(iheader,'INSTRUME')
telescop=fxpar(iheader,'TELESCOP')

pmcsun=fxpar(iheader,'CRPIX1')
naxis1=fxpar(iheader,'NAXIS1')
if pmcsun EQ 0 or pmcsun GE naxis1 then pmcsun=255.5
if ABS(pmcsun*2-naxis1) GT 10 then pmcsun=naxis1*0.5

radius=fxpar(iheader,'SOLR')
if radius eq 0 then begin
cdelt1=fxpar(iheader,'CDELT1')
cdelt0=cdelt1
;cdelt1=cdelt1*2
radius=964.2;491
;radius=radius*258
fxaddpar, iheader, 'CDELT1', cdelt1, 'x scale  /idl2'
endif
;if instrume EQ 'EIT' then begin
;radius=fxpar(iheader,'SOLAR_R')*cdelt0
;cdelt01=fxpar(header0,'CDELT1')
;radius=fxpar(header0,'SOLAR_R')*cdelt01
;naxis01=fxpar(header0,'NAXIS1')
;print, cdelt01,radius,naxis01
;end

freq=fxpar(iheader,'OBS-FREQ')

;if freq EQ 0 then begin
;freq=20
;fxaddpar, iheader, 'OBS-FREQ', freq, 'frequency  /idl2'
;endif

wlnth=0;
wlnth=fxpar(iheader,'WAVELNTH')
if wlnth NE 0 then freq=30000/wlnth;x10^8


fxaddpar, iheader, 'PMCSUN', pmcsun, 'post meridium center /idl2'
fxaddpar, iheader, 'RADIUS', radius, 'optical solar radius, arcsec /idl2'
fxaddpar, iheader, 'ANGLE', fxpar(iheader,'DEC'), ' declination( deg) /idl2'
date_obs=fxpar(iheader,'DATE-OBS')

telescop=strcompress(fxpar(iheader,'TELESCOP'), /REMOVE_ALL)
if telescop EQ 'radioheliograph' then begin
strput,date_obs,'/', strpos(date_obs,'-')
strput,date_obs,'/', strpos(date_obs,'-')
endif

if telescop eq 'SSRT'  then begin
;DT=STR_TO_DT(date_obs,time_obs,DATE_FMT=2)
;print, DT
;if DT.year EQ 1900 then DT.year=2000
;date_obs=strcompress((string(DT.year)+'/'+strcompress(fix(DT.month))+'/'+strcompress(fix(DT.day))), /REMOVE_ALL)
endif

;tqsun=16000.0
tqsun=9000.0

if telescop EQ 'radioheliograph' then tqsun=4800.0

fxaddpar, iheader, 'DATE-OBS', date_obs, 'added by idl'
;fxaddpar, iheader, 'OBS-FREQ', freq, 'GHz, added by idl'
fxaddpar, iheader, 'POLARSET', 1, ' added by idl'
fxaddpar, iheader, 'FLAG_IV', 0, ' added by idl'
fxaddpar, iheader, 'TQSUN', tqsun, ' added by idl'
fxaddpar, iheader, 'FLUX_L', 0.078, ' added by idl'
fxaddpar, iheader, 'THETA-DG', 20.0, ' added by idl'

;bscale1=1
;bscale2=-1
;bzero1=0
;bzero2=0

;bscale1 =  max(scan(*,im))/16000.0
;bzero1=min(scan(*,im))
;scan(*,im)=scan(*,im)-min(scan(*,im))
;scan(*,im)=(scan(*,im)*16000.0/max(scan(*,im)))

;bscale2 =  abs_max/300.0
;bzero2=mean(pol(0:15,im))
;pol(*,im)=(-1.0)*(pol(*,im)-bzero2)/bscale2


if telescop EQ 'SSRT' then begin
;abs_max= max([max(scan(*,im)), abs(min(scan(*,im)))])
;bscale1 =  max(scan(*,im))/3000.0
;bzero1=min(scan(*,im))
;scan(*,im)=scan(*,im)-min(scan(*,im))
;scan(*,im)=(scan(*,im)*3000.0/max(scan(*,im)))
;abs_max= max([max(pol(*,im)), abs(min(pol(*,im)))])
;bscale2 =  abs_max/300.0
;bzero2=mean(pol(0:15,im))
;pol(*,im)=(-1.0)*(pol(*,im)-bzero2)/bscale2

endif
print, 'max(scan(*,im))', max(scan(*,im)),' ',min(pol(*,im))
;print,scan

fxaddpar, iheader, 'BSCALE1', bscale1, ' added by idl'
fxaddpar, iheader, 'BSCALE2', bscale2, ' added by idl'
fxaddpar, iheader, 'BZERO1', bzero1, ' added by idl'
fxaddpar, iheader, 'BZERO2', bzero2, ' added by idl'

;plot, scan(*,im),background=1,TITLE=date_obs, xtitle='pixels',$
;       YTITLE='Ta', XRANGE=[0,naxis1],YRANGE=[MIN(scan),1.1*MAX(scan)],/XSTYLE
;oplot, pol(*,im),LINE=im

scanw(*,0)=fix(scan(*,im))
scanw(*,1)=fix(pol(*,im))

myfile=strmid(ifile,strlen(mydir), strlen(ifile)-strlen(mydir))

printf,1, 's'+myfile
;writefits,mydir+'s'+myfile,scanw,iheader
writefits,'s'+myfile,scanw,iheader
;if (im EQ 0) then begin
;window,1, xsize=603 ; dlja sopostavlenija s 2D
fl_file=2
;telescop='RATAN-600'
;plot, scanw(*,1),background=1,TITLE=date_obs +'/'+telescop, xtitle='pixels',$
;       YTITLE='Ta', XRANGE=[0,naxis1],YRANGE=[MIN(scanw),1.1*MAX(scanw)],/XSTYLE
;       yshift=median(scanw(*,0))/2
;plot, scanw(*,1);+yshift,LINE=im
;window,2
;wdelete,2
;endif else begin
;oplot, scanw(*,0),background=1,TITLE=date_obs, xtitle='pixels',$;
       ;YTITLE='Ta', XRANGE=[0,naxis1],YRANGE=[MIN(scanw),1.1*MAX(scanw)],/XSTYLE
;oplot, scanw(*,1),LINE=im
;endelse
endfor

close,1

kon:
END