; $Id: calendars.pro,v 1.5 2019/11/12 20:16:28 nathan Exp $ ; Idl routines that produce calendars. ; ; summary: produces STEREO calender with date, day of year, ; and STEREO day in each box. runs with IDL version 2 ; ; format and calls: ; calendars,year,month - 1 month calendar on one portrait page ; calendars,year - 12 months on 12 landscape page ; calendars,year, PAGE=1 - 12 months on one landscape page ; ; PostScript keyword writes file of Postscript ; else to current plot device ; ; KEYWORDS: ; /POSTSCRIPT writes .ps and .pdf files ; PAGES= Number of pages in output: 1,2,3, or 6 ; LAUNCHDATE= Launch date for any mission; defaults to STEREO launch ; ; Example usage: ; ; Restrictions: ; ; TJD date routines don't work for days before 1968, March (JD 2440000) ; ; Notes: ; ; This was written by one of the OSSE Gamma Ray Observatory ; Team members. We use it with his blessings, but ; ; Buyer beware!! ; ; ; $Log: calendars.pro,v $ ; Revision 1.5 2019/11/12 20:16:28 nathan ; print row major order ; ; Revision 1.4 2012/02/10 19:01:47 nathan ; increase doy size and decrease day of month size ; ; Revision 1.3 2012/02/10 18:20:56 nathan ; added LAUNCHDATE= and remove stop ; ; Revision 1.2 2012/02/09 22:14:58 nathan ; re-write so all options controlled by PAGES= instead of different procedure calls ; ; mod 08 Nov 95 - to correct dec 6 having only 30 days. ; ;------------------------------------------------------------------------- function day_of_year,yr,mo,day ;+ ; NAME: ; DAY_OF_YEAR ; PURPOSE: ; convert date expressed as yr,month,day into day of year ; of form yy/ddd hh:mm:ss ; ; CATEGORY: ; utility ; ; CALLING SEQUENCE: ; doy = day_of_year(yr,mo,day) ; ; INPUTS: ; yr - int year, eg. 1991 (used for leap lear calcs) ; mo - int month, (1..12) ; day - int day of month (1..31) ; ; OUTPUTS: ; returned value, integer day of year (1..366) ; RESTRICTIONS: ; no checking is performed for rational combinations of yr,mo,day ; MODIFICATION HISTORY: ; Revised, wnj, NRL, Nov, 1991 - fix leap year calculation ; ; Written, wnj, NRL, April, 1991 ;- ; ; day_tab = [0,31,28,31,30,31,30,31,31,30,31,30,31, $ ; 0,31,29,31,30,31,30,31,31,30,31,30,31] day_tab = [0,31,59,90,120,151,181,212,243,273,304,334,365, $ 0,31,60,91,121,152,182,213,244,274,305,335,366] leap = ((fix(yr) mod 4 eq 0) and (fix(yr) mod 100 ne 0)) $ or (fix(yr) mod 400 eq 0) if leap then i= 13 else i = 0 dt = day_tab(i+mo-1) + day return,dt end function trunc_jd,yr,mo,day ;decompose=0 ; convert integers yr,mo,day into trunc julian day number ; eg yr = 1990, mo = 12, day = 25 ; tjd = jd - 2440000.5 ; function returns double tjd doy = day_of_year(yr,mo,day) nyr1 = yr - 1 nc = nyr1/100 nd = long(nyr1)*365 + nyr1/4 - nc +nc/4 + doy jd = 1721424 + nd tjd = jd - 2440000 return,long(tjd) end pro tjd_to_ymd,tjd,yr,mo,day ; input tjd, return yr,mo,day day_tab = [0,31,59,90,120,151,181,212,243,273,304,334,365, $ 0,31,60,91,121,152,182,213,244,274,305,335,366] nd = long(tjd)+718576 yr = long(nd/365.2425) nc = yr/100 nd1 = yr*365 + yr/4 - nc +nc/4 doy = nd - nd1 if doy eq 0 then begin yr = yr-1 nc = yr/100 nd1 = yr*365 + yr/4 - nc +nc/4 doy = nd - nd1 ; added 08nov95 endif yr = yr + 1 leap = ((fix(yr) mod 4 eq 0) and (fix(yr) mod 100 ne 0)) $ or (fix(yr) mod 400 eq 0) if leap then i= 13 else i = 0 m = where(day_tab(i:i+12) ge doy) mo = m(0) day = doy-day_tab(i+mo-1) return end pro doit,inyr,inmo,inday,postscript=ps common calendarvar, tjd0 bthick=1 maxx = 0.999 maxy = 0.999 ygrid = findgen(9)*maxy/7.3 xgrid = findgen(8)*maxx/7.0 x_size = xgrid(1)-xgrid(0) t_size = (ygrid(1)-ygrid(0)) d_size = 0.4*t_size doy_size = 0.3*t_size ygrid(7)=ygrid(6)+0.3*t_size month = ['January','February','March','April','May','June','July',$ 'August','September','October','November','December'] dayname = ['Sunday','Monday','Tuesday','Wednesday','Thursday',$ 'Friday','Saturday'] date_offset = ygrid+t_size-0.7*d_size doy_offset = ygrid+t_size-d_size-0.8*doy_size tjd_offset = ygrid+t_size-d_size-1.8*doy_size box_x = [0,maxx,maxx,0,0] box_y = [ygrid(6),ygrid(6),ygrid(7),ygrid(7),ygrid(6)] !x.margin=[1,1] !y.margin=[1,1] ;clr=['FFFFFF'x,'000000'x,'0000FF'x,'FF0000'x];,'FF0000'x,'8888FF'x] tek_color if ~keyword_set(ps) then device,decompose=0 clr=[1,0,4,2] ;if keyword_set(ps) then begin ; ps_color,2,8,/preview ; clr=[1,0,4,2] ;endif plot,box_x,box_y,xrange=[0,maxx],yrange=[0,maxy],ystyle=4,xstyle=4,thick=bthick,background=clr(0),color=clr(1) for i=1,6 do oplot,[xgrid(i),xgrid(i)],[ygrid(6),ygrid(7)],color=clr(1) cnorm = !d.y_vsize/!d.y_ch_size*(!y.region(1)-!y.region(0)) csize = 0.7*t_size*cnorm xyouts,maxx*0.5,ygrid(7)+0.2*t_size,alignment=0.5,charsize=csize, $ month(inmo-1)+' '+strtrim(inyr,2),color=clr(1) ; 03DEC93 OLD WAS csize = 0.2*t_size*cnorm csize = 0.15*t_size*cnorm for i=0,6 do begin xyouts,xgrid(i)+0.5*x_size,ygrid(6)+0.08*t_size,alignment=0.5, $ charsize=csize,dayname(i),color=clr(1) endfor tjd = long(trunc_jd(inyr,inmo,inday)) ;1990,12,25 tjd_to_ymd,tjd,yr,mo,day dow1 = (tjd+5) mod 7 lyd=-1 while mo eq inmo do begin doy = day_of_year(yr,mo,day) dow = (tjd+5) mod 7 yd = 5-fix((dow1+day-1)/7) if lyd ne yd then begin oplot,[0,maxx],[ygrid(yd),ygrid(yd)],color=clr(1) oplot,[xgrid(0),xgrid(0)],[ygrid(yd),ygrid(yd+1)],color=clr(1) oplot,[xgrid(7),xgrid(7)],[ygrid(yd),ygrid(yd+1)],color=clr(1) endif lyd = yd oplot,[xgrid(dow),xgrid(dow)],[ygrid(yd),ygrid(yd+1)],color=clr(1) oplot,[xgrid(dow+1),xgrid(dow+1)],[ygrid(yd),ygrid(yd+1)],color=clr(1) csize = 0.8*doy_size*cnorm xyouts,xgrid(dow)+0.04*x_size,date_offset(yd),alignment=0, $ charsize=csize, strtrim(day,2),color=clr(1) csize = 0.9*d_size*cnorm xyouts,xgrid(dow+1)-0.1*x_size,doy_offset(yd),alignment=1, $ charsize=csize, strtrim(doy,2),color=clr(3) csize = 0.8*doy_size*cnorm xyouts,xgrid(dow+1)-0.1*x_size,tjd_offset(yd),alignment=1, $ charsize=csize, strtrim(tjd-tjd0,2),color=clr(2) if(day eq 1)then begin if(i eq 13)then ix=366.00 else ix=365.00 yrfrac=(doy/ix) & yrfrac=string(yrfrac,'(f4.2)') xyouts,xgrid(dow+1)-0.1*x_size,date_offset(yd),alignment=1, $ charsize=csize, yrfrac,color=clr(1) endif tjd = tjd+1 tjd_to_ymd,tjd,yr,mo,day endwhile return end ;------------------------------------------------------------------------------ pro calendars,inyr, inmo, postscript=ps, PAGES=pages, LAUNCHDATE=launchdate ;default whole year on 12 pages, landscape common calendarvar, tjd0 IF keyword_set(LAUNCHDATE) THEN BEGIN dstr=utc2str(anytim2utc(launchdate)) y=fix(strmid(dstr,0,4)) m=fix(strmid(dstr,5,2)) d=fix(strmid(dstr,8,2)) tjd0=trunc_jd(y,m,d) ENDIF ELSE tjd0=trunc_jd(2006,10,25) pmulti=[0,0,0] npa=12 IF keyword_set(PAGES) THEN BEGIN npa=pages case pages of 1: pmulti=[0,4,3,0,1] 2: pmulti=[0,2,3,0,1] 3: pmulti=[0,2,2,0,1] 6: pmulti=[0,1,2,0,1] 12: ELSE: BEGIN print,'Only number of pages allowed: 1,2,3,6,12',/info exit END ENDCASE ENDIF ten=0 IF pmulti[1] GE pmulti[2] THEN BEGIN lands=1 portr=0 ysi=7.5 xsi=10. ten=10. ENDIF ELSE BEGIN lands=0 portr=1 ysi=10. xsi=7.5 ENDELSE IF n_params() GT 1 THEN BEGIN npa=1 mons=[inmo,inmo] ENDIF ELSE mons=[1,12] olddev = !d oldf = !p.font !p.multi=pmulti if keyword_set(ps) then begin !p.font=0 set_plot,'ps' filenm=string(inyr,'(i4.4)')+'_'+trim(npa)+'page.ps' device,portrait=portr, landscape=lands,filen=filenm,/schoolbook,/color ,/inches,ysize=ysi,yoffset=ten+0.5,xsize=xsi,xoffset=0.5 endif else begin !p.font=-1 endelse for inmo = mons[0],mons[1] do if keyword_set(ps) then doit,inyr,inmo,1,/postscript else doit,inyr,inmo,1 if keyword_set(ps) then begin device,/close print,'PS filename '+filenm cmd='ps2pdf '+filenm spawn,cmd endif set_plot,olddev.name !p.font=oldf !p.multi=0 return end