; ; This code will produce contour synoptic maps from binary ; synoptic maps. The binary synoptic maps come from the ; ftp directory mk3/map/binary. ; ; This code expects *both* the 1.36 and the 1.74 height binary files. ; ; Please ask alice@ncar.ucar.edu if you have any questions. ; --> This code was written by Alice Lecinski 5/5/95 <-- ; ; !P.MULTI = [ 0, 1 , 2 ] filenm=' ' one2one=0 heights = ['1.36','1.74'] if(n_elements(SCLans) eq 0) then begin ;{ SCLans='n' roti='1894' mlmb='e' print,'Enter the rotation you are interested in, like: 1894 -->' read, roti print,'Enter the limb you are interested in, like: e or w -->' read, mlmb print,' ' print,'This code can produce either 1 to 1, or extended longitude scaling.' print,'Do you want 1 to 1 (lat long) scaling? (y or n) -->' read,SCLans endif;} psfilenm=roti+mlmb+'.ps' set_plot,'ps' if(SCLans eq 'y')then begin ;{ one2one=1 device,/portrait,/inches,$ xsize=8.25,ysize=8.70,xoffset=0.25,yoffset=1.0,filename=psfilenm endif $ else begin ;}{ device,/landscape,/inches,$ xsize=10.0,ysize=7.5,xoffset=0.5,yoffset=10.5,filename=psfilenm endelse;} print,' ' print,'This code will produce the postscript file --> ',psfilenm,' <-- which' print,' will contain synoptic maps at both 1.36 and 1.74 Rsun' print,' ' for zz=0,1 do begin;{ myhei =heights(zz) ckey=0 & ckey=bytarr(80) amap=0 & amap=intarr(360,181) smap=0 & smap=intarr(360,181) doy=0 aday=0 & doy=intarr(80) tailor=' ' & tailor2=' ' & substr=' ' fbdoy=0. & fedoy=0. bdoy=long(0) & byr=long(0) edoy=long(0) & eyr=long(0) filenm=roti+mlmb+myhei print,' ' print,'********** Trying to open the binary map file: ',filenm close,1 openr,1,filenm & readu,1,amap & readu,1,bdoy readu,1,byr readu,1,edoy readu,1,eyr yrfix=0 if ( byr lt eyr ) then begin;{ yrfix = (long(365) + $ long((byr mod 4 eq 0) and (byr mod 100 ne 0) or $ (byr mod 400 eq 0))) * long(100) edoy = edoy + yrfix print,'fixing edoy with yrfix',edoy,yrfix endif $ else if ( bdoy gt long(366)*long(100) ) then begin;}{ yrfix = (long(365) + $ long((byr mod 4 eq 0) and (byr mod 100 ne 0) or $ (byr mod 400 eq 0))) * long(100) bdoy = bdoy - yrfix if (edoy gt 366) then edoy = edoy - yrfix print,'Fixing edoy with yrfix',edoy,yrfix yrfix=0 endif;} fbdoy=float(bdoy)/100. fedoy=float(edoy)/100. yrfix=yrfix/100 print,' ' print,'Map ',filenm print,'Beginning doy and yr',fbdoy,byr print,'Ending doy and yr ',fedoy,eyr bdoy=fix(fbdoy) edoy=fix(fedoy) ii=0 readf,1,tailor2 ;& print,tailor2 readf,1,tailor ;& print,tailor blipo=0 while ( not eof(1) ) do begin ;{ readf,1,tailor ;& print,tailor jj = strpos(tailor,'CM') ;;; Make sure there is a doy to get... blipo=blipo+1 ;print,jj,blipo,tailor if(jj ne -1) then begin ;{ substr=strmid(tailor,14,3) reads,substr,aday if( aday lt 100) then aday = aday + yrfix if ( (aday ge bdoy) and (aday le edoy)) then begin;{ doy(ii)=aday ii=ii+1 endif;} endif;} endwhile;} close,1 numdoys=ii & doys=intarr(numdoys) & for ii=0,numdoys-1 do doys(ii)=doy(ii) numday = (edoy-bdoy)+1 ;Reverse the doys Rdoys=rotate(doys,5) ;print,doys,Rdoys jj=0 for ii=0,numday-1 do begin;{ aday = edoy-ii if (jj lt numdoys) then begin;{ if(jj gt 0 and jj lt numdoys-1) then $ if (Rdoys(jj-1) eq Rdoys(jj)) then jj=jj+1 if(Rdoys(jj) eq aday) then begin ;{ Stupid idl!!!!!! jj=jj+1; ckey(ii) = 48 endif ;} endif else begin ;}{ ckey(ii) = 0 endelse;} endfor ;} waysm=1 if(waysm) then begin;{ smsz=12 & len=360+2*smsz & bgmap=intarr(len,181) for ii=0,smsz-1,1 do bgmap(ii,0:180)=amap(0,0:180) for ii=359+smsz,len-1,1 do bgmap(ii,0:180)=amap(359,0:180) for ii=0,359,1 do bgmap(ii+smsz,0:180)=amap(ii,0:180) bsmap=smooth(bgmap,smsz) smap(0:359,0:180) = bsmap(smsz:359+smsz,0:180) endif else begin;}{ smap=smooth(amap,5) endelse ;} Rsmap=rotate(smap,7) if( mlmb eq 'e' ) then limb=' East limb' if( mlmb eq 'w' ) then limb=' West limb' rot = 'Carrington Rotation '+roti bdate = string(format=$ '(" Bdoy ",f6.2," ",i4)',fbdoy,byr) if(one2one) then edate = string(format=$ '("Edoy ",f6.2," ",i4," ")',fedoy-yrfix,eyr) $ else edate = string(format=$ '("Edoy ",f6.2," ",i4," ")',fedoy-yrfix,eyr) height = myhei+' Rsun June 1993 cal HAO/MLSO data' lvl2= [ 1200., 1400., 1600.] clr2= [140,180,220] lvl= [200., 400., 600., 800., 1000., 1200., 1400., 1600.] if( myhei eq '1.74') then $ lvl= [50., 100., 200., 400., 600., 800., 1000., 1200. ] mln= [1, 0, 2, 0, 2, 0, 0, 0] mln= [1, 0, 0, 0, 0, 0, 0, 0] thk= [1, 1, 2, 3, 4, 2, 2, 3] myyticks=6 & myytickv=findgen(7)*30 myxticks=numday-1 myxtickv=fltarr(numday) deltax = 360./(fedoy - fbdoy) offset = (fedoy-float(edoy)-1.) * deltax print,'offset is: ',offset myxname=replicate(' X ',numday) for ii=0,myxticks do begin ;{ if(ckey(ii) eq 48) then begin ;{ myxname(ii) = string(format='(i8)',edoy-ii) endif;} myxtickv(ii) = offset + ii*deltax endfor ;} myyname=replicate(' ',19) myyname(0)='-90' myyname(6)=' 90' myyname(3)=' 0' mytit=edate+rot+limb+bdate xsz=0.6 if(one2one) then begin ;{ mytit=edate+bdate xsz=0.5 endif;} contour,Rsmap,/follow,levels=lvl,$ c_linestyle=mln,$ c_thick=thk,$ xstyle=1,ystyle=1,zstyle=1,charsize=1.0,$ xcharsize=xsz,$ xtitle='DOY', ytitle='LATITUDE',$ title=mytit ,$ subtitle=height, $ xtickname=myxname,$ ytickname=myyname,$ xticks=myxticks,xtickv=myxtickv, $ yticks=myyticks,ytickv=myytickv, $ ticklen= -0.015 , xmargin=[10,10] , ymargin=[4,4] contour,Rsmap,/follow,levels=lvl2,c_color=clr2,overplot=1,fill=1 oplot,[0,359],[90,90],thick=2 if(one2one) then xyouts,180,450,rot+limb,align=0.5,/data,charsize=2.0 endfor;} device,/close set_plot,'x' end