;$Id: schedule_plot.pro,v 1.14 2013/01/09 13:33:23 mcnutt Exp $ ; ; Project : STEREO - SECCHI ; ; Name : SCHEDULE_PLOT ; ; Purpose : Plot schedule in SECCHI Scheduling tool's plot window. ; ; Explanation : This routine plots the current: DSN contact, GT-dumps, SCIP Door ; schedules, OS's, Secchi-Buffer (RAM-disk), SSR1-channel, SSR2-channel, ; RT-channel, and SW-channel in the Scheduling tool's output window. ; ; Use : SCHEDULE_PLOT, schedv ; ; Inputs : schedv Structure containing widgets information including ; startdis Start of display time in TAI. ; enddis End of display time in TAI. ; ; Opt. Inputs : None. ; ; Outputs : None. ; ; Opt. Outputs: None. ; ; Keywords : None. ; ; Restrictions: None. ; ; Side effects: None. ; ; Category : Planning, Scheduling. ; ; Prev. Hist. : Adapted from SOHO/LASCO planning tool. ; ; Written by : Ed Esfandiari, NRL, May 2004 - First Version. ; ; Modification History: ; Ed Esfandiari 06/07/04 - Removed SECCHI un-related labels. ; 06/14/04 - Corrected non-seq cadences eventhough not used. ; Ed Esfandiari 06/18/04 - For a SCIP seq, expand the images pre_proc_times using ; actual exptimes of each image. ; Ed Esfandiari 06/30/04 - Added orig_start, os_start, and same_seq_start_time to expand_os. ; Ed Esfandiari 07/16/04 - Added filter/polar dependent setup time for SCIP seq. images. ; Ed Esfandiari 08/16/04 - Use physical exptime units of sec (from read_exp_tables). ; Ed Esfandiari 09/21/04 - Distinguished synced OSes with color OS numbers and image types. ; Ed Esfandiari 09/30/04 - removed sync color. ; Ed Esfandiari 10/04/04 - Added conf and removed gipt. ; Ed Esfandiari 10/22/04 - Mark SC A/B images if both displayed (3 hrs or less). ; Ed Esfandiari 12/06/04 - Added code to display BSF file(s) info. ; Ed Esfandiari 12/13/04 - use pre_proc_times from os_get_pre_proc_time that has CCD summing ; corrected exptimes instead of using ex. ; Ed Esfandiari 01/28/05 - Added code to calculate image processing times for HI summed seq ; images using real table steps for first, middle, and last images. ; Ed Esfandiari 02/03/05 - Added code to handle "Initialize Timeline" commands. ; Ed Esfandiari 05/03/05 - Added code to display Run Script file(s). ; Ed Esfandiari 05/25/05 - Adjust SSR1 and SSR2 rates for acutual length of playback. ; The rates in channels structure are bits/sec assuming a 24 hr ; playback. For actual daily playbacks (~4 hrs), must increase the ; SSR1 and SSR2 rates since the same volume of data is played-back ; that would have been played-back in 24hr using channels rates. ; The adjustment (rate/sec) is made using the length of each playback ; and not the span of the schedule that is displayed by PT. ; ; Ed Esfandiari 05/26/05 - Added option to use 24hr fake playback that can be used for ; calibration/ground testing instead of actual scheduled playbacks. ; Ed Esfandiari 10/27/05 - Added Hour glass. ; Ed Esfandiari 05/08/06 - Added proc_times for multi apid OSes. ; Ed Esfandiari 05/09/06 - Allow 8.* filenames for Run Scripts. ; Ed Esfandiari 05/19/06 - Added Start buffer and APID % and SSR2 playback % info to plot ; display and also SC A and B independency. ; Ed Esfandiari 08/17/06 - Made changes for using secchig display. ; Ed Esfandiari 08/22/06 - Added data rate (drate) selection. ; Ed Esfandiari 08/30/02 - Added RT rates read and used from SCA file. ; Ed Esfandiari 09/01/06 - Added GT rates. ; Ed Esfandiari 09/02/06 - Added nominal 3.26 kbps HK rate to SSR1 and RT. ; Ed Esfandiari 09/06/06 - commented out rt_pct_start and ssr2_pct_pb info. ; Ed Esfandiari 03/13/07 - Added ccd-clear bar for each displayed image. ; Ed Esfandiari 11/09/07 - Added code to initialize statistics before calls to PLOT_*_CHANNEL routines. ; Ed Esfandiari 01/30/09 - used new secchi_ssr_rate_info.sav instead of ; secchi_ssr_info.sav with volumes and rates ; of all future mission rate changes. ; Ed Esfandiari 08/27/09 - Added new HI sample, HI1SPW, HI2PW, HI word, and LO word IP function ; effects on resources. ; ; ; $Log: schedule_plot.pro,v $ ; Revision 1.14 2013/01/09 13:33:23 mcnutt ; changed made when generating new block sched 20130108 ; ; Revision 1.13 2011/06/30 20:38:01 nathan ; call read_sca and os_init if not defined ; ; Revision 1.12 2011/06/15 22:55:19 nathan ; Allow input of OSID; note that changed num_text from string with prefix to ; just a 4-digit number. Possibly output is affected. ; Also changed default state to ST-A instead of both, and automatically ; computes tlm volumes. ; ; Revision 1.11 2009/09/11 20:28:23 esfand ; use 3-digit decimals to display volumes ; ; Revision 1.7 2005/12/16 14:58:52 esfand ; Commit as of 12/16/05 ; ; Revision 1.6 2005/05/26 20:00:59 esfand ; PT version used to create SEC20050525005 TVAC schedule ; ; Revision 1.5 2005/03/10 16:50:40 esfand ; changes since Jan24-05 to Mar10-05 ; ; Revision 1.4 2005/01/24 17:56:35 esfand ; checkin changes since SCIP_A_TVAC ; ; Revision 1.2 2004/09/01 15:40:47 esfand ; commit new version for Nathan. ; ; Revision 1.1.1.2 2004/07/01 21:19:10 esfand ; first checkin ; ; Revision 1.1.1.1 2004/06/02 19:42:36 esfand ; first checkin ; ; ;- ;__________________________________________________________________________________________________________ ; PRO REMOVE_SAVED_IMAGES, oses , defined_os_arr ; exclude images marked as saved (IP fun. 56, 60, or 64) from percents. (not needed since ; this is only done for SW channel and SW only listed for the last image. FOR i= 0, N_ELEMENTS(defined_os_arr)-1 DO BEGIN osn= defined_os_arr(i).os_num ipt= defined_os_arr(i).iptable steps= defined_os_arr(i).ip(ipt).steps omit= WHERE(steps EQ 56 OR steps EQ 60 OR steps EQ 64, ocnt) IF (ocnt GT 0) THEN BEGIN ind= WHERE(oses.os_num NE osn, icnt) IF (icnt GT 0) THEN oses= oses(ind) print,'Excluded OS_'+STRTRIM(osn,2)+' with "Saved As" (IP func 56, 60, or 64) from downlink.' ENDIF ENDFOR RETURN END PRO SCHEDULE_PLOT, schedv COMMON OP_SCHEDULED COMMON OP_DEFINED COMMON OS_SCHEDULED COMMON OS_DEFINED COMMON OBS_PROG_DEF COMMON OS_PLOT_SHARE, os_yarr COMMON KAP_INIT COMMON KAP_INPUT COMMON SCHEDULE_BUFFER, save_buffer COMMON SCIP_DOORS_SHARE ; AEE - 6/3/03 COMMON APIDS, multi_apid ; AEE - 7/17/03 COMMON GT_DUMPS_SHARE ; => stime_gt, etime_gt, apid_gt ; AEE 7/25/03 COMMON EXPANDED_OS, expanded ; AEE 1/15/04 COMMON HDR_ONLY_REMOVED, no_ho_expanded COMMON CMD_SEQ_SCHEDULED COMMON OS_ALL_SHARE, ccd, ip, ipd, ex, exd, occ_blocks, roi_blocks, fpwl, fpwld COMMON OS_INIT_SHARE, op_types, tele_types, table_types, fw_types, pw_types, exit_types, proc_tab_types, $ ip_arr, plan_lp, lprow, cor1pw, cor2pw COMMON INIT_TL, ic COMMON RUN_SCRIPT, rsc COMMON DIALOG,mdiag,font COMMON RT_CHANNEL, rt_rates, rtrate COMMON TM_DATA WIDGET_CONTROL, /HOUR WIDGET_CONTROL,mdiag,SET_VALUE='Updating Plot .......' startdis = schedv.startdis enddis = schedv.enddis charsize = schedv.charsize WSET, schedv.win_index ; ; Get the character size. ; datastart = TAI2UTC(startdis) ; form .DAY and .TIME ; START_HOUR Start of display plot, in # hours into the STARTDIS day ; STOP_HOUR End of display plot in # hours since STARTDIS (maybe >24) t1 = datastart.time / 3600000. ; start display at this hour t2 = t1 + ((enddis - startdis) / 3600d) ; end display hour datastart.time = 0 ; only want day part daystart = UTC2TAI(datastart) ; start of STARTDIS in TAI IF N_ELEMENTS(charsize) EQ 0 THEN BEGIN IF !P.CHARSIZE GT 0 THEN charsize = !P.CHARSIZE ELSE $ charsize = 1 ENDIF ; draw window will contain two plots !P.MULTI = [0,0,2,0,0] IF (DATATYPE(kap_resource_arr) NE 'STC') THEN BEGIN READ_SCA, schedv.sc, schedv.startdis, schedv.enddis, /DEFAULT OS_INIT ENDIF ;-------- FIRST PLOT --------------- ; ; Make the plot frame, but don't plot the X axis. ; !Y.MARGIN = [2, 2] ;** bottom and top margin in chars rows = 100 ;** yrange [0,100] IF N_ELEMENTS(xtitle) EQ 0 THEN xtitle=TAI2UTC(startdis, /ECS) ELSE xtitle = xtitle PLOT,[t1,t2],[0,rows-1],/NODATA,XSTYLE=5,YSTYLE=1,YTICKS=1, $ YTICKNAME=REPLICATE(' ',2),XMARGIN=[15,4],CHARSIZE=charsize, $ XTICK_GET=XTICKS,PSYM=0,LINESTYLE=0, TITLE=xtitlE ; ; Plot the X axis with time format labels. ; HOURS = FIX(XTICKS) MOD 24 W = WHERE(HOURS LT 0, COUNT) IF COUNT GT 0 THEN HOURS(W) = HOURS(W) + 24 MINUTES = 60*(XTICKS - FIX(XTICKS)) W = WHERE(MINUTES LT 0, COUNT) IF COUNT GT 0 THEN BEGIN HOURS(W) = HOURS(W) - 1 MINUTES(W) = MINUTES(W) + 60 ENDIF W = WHERE(MINUTES GE 60, COUNT) IF COUNT GT 0 THEN BEGIN HOURS(W) = HOURS(W) + 1 MINUTES(W) = MINUTES(W) - 60 ENDIF HOURS = STRMID(STRING(100+HOURS,FORMAT='(I3)'),1,2) ; MINUTES = STRMID(STRING(100+FIX(MINUTES+0.5),FORMAT='(I3)'),1,2) ; AEE - 01/15/03 - changed date format from HH:MM to HH:MM:SS since for some ; of the plots, date labels were not accurate. MM= STRING(MINUTES,'(I2.2)') SS= STRING(MINUTES*60 MOD 60,'(I2.2)') ;AXIS,XAXIS=0,XSTYLE=1,XTICKNAME=HOURS+':'+MINUTES,CHARSIZE=charsize AXIS,XAXIS=0,XSTYLE=1,XTICKNAME=HOURS+':'+MM+':'+SS,CHARSIZE=charsize AXIS,XAXIS=1,XSTYLE=1,XTICKNAME=REPLICATE(' ',30) dy = !D.Y_CH_SIZE * charsize / (3 * !Y.S(1) * !D.Y_SIZE) ;mins = ((enddis - startdis) / 60D)+1 ;** minutes in plotting range secs = (enddis - startdis) + 1 ; AEE - Dec 16, 02 . Display plotting range in seconds for secchi. ; ; ; Draw the lines for BSF files reports & Plot ; ;IF (DATATYPE(sched_cmdseq) EQ 'STC') THEN BEGIN IF (DATATYPE(sched_cmdseq) EQ 'STC' AND DATATYPE(os_arr) EQ 'STC') THEN BEGIN yb = 6. & yt = 27. OPLOT,[t1,t2],[yb,yb],PSYM=0,LINESTYLE=0 OPLOT,[t1,t2],[75.0,75.0],PSYM=0,LINESTYLE=0 oyy1= yb+1.0 h=8.0 oyy2= oyy1+h FOR j= 0,1 DO BEGIN IF (j EQ 0) THEN BEGIN cind= WHERE(sched_cmdseq.sc EQ 'A', ccnt) lab='BSF (S/C A) ' ENDIF ELSE BEGIN cind= WHERE(sched_cmdseq.sc EQ 'B', ccnt) lab='BSF (S/C B) ' ENDELSE IF (ccnt GT 0) THEN BEGIN XYOUTS,t1,oyy1+h/2-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,lab cmdseq= sched_cmdseq(cind) FOR i=0, N_ELEMENTS(cmdseq)-1 DO BEGIN bsfile= STR_SEP(cmdseq(i).bsfile,'/') bsfile= cmdseq(i).bsf+': '+bsfile(N_ELEMENTS(bsfile)-1) time_range= STR_SEP(cmdseq(i).os_time,',') srtm= UTC2TAI(STR2UTC(time_range(0))) bos= STR_SEP(cmdseq(i).os_num,',') lbos= LONG(bos(N_ELEMENTS(bos)-1)) ertm= UTC2TAI(STR2UTC(time_range(N_ELEMENTS(time_range)-1))) oind= WHERE(os_arr.os_num EQ lbos AND os_arr.os_start EQ ertm,ocnt) IF (ocnt EQ 1) THEN $ ertm= os_arr(oind(0)).os_stop $ ELSE $ ertm= UTC2TAI(STR2UTC(time_range(N_ELEMENTS(time_range)-1)))+30 ;add 30sec for last OS duration x1 = (srtm - daystart) / 3600D x2 = (ertm - daystart) / 3600D x1 = x1 > !X.CRANGE(0) x2 = x2 < !X.CRANGE(1) IF X2 GT X1 THEN BEGIN pat= bytarr(4,4) IF i mod 2 EQ 0 THEN BEGIN pat(2,2)= i MOD 11 + 1 yy1= oyy1 yy2= oyy2-2.0 ENDIF ELSE BEGIN pat(1,1)= i MOD 11 +1 yy1= oyy1+2.0 yy2= oyy2 ENDELSE POLYFILL, [x1,x2,x2,x1], [yy1,yy1,yy2,yy2], pat= pat WRITE_IN_BOX,X1,X2,yy1,yy2,bsfile OPLOT, [X1,X1], [yy1,yy2], PSYM=0, LINESTYLE=0 OPLOT, [X2,X2], [yy1,yy2], PSYM=0, LINESTYLE=0 OPLOT, [X1,X2], [yy1,yy1], PSYM=0, LINESTYLE=0 OPLOT, [X1,X2], [yy2,yy2], PSYM=0, LINESTYLE=0 ENDIF ;stop ENDFOR OPLOT, [!x.crange(0),!x.crange(1)],[oyy2+1,oyy2+1], PSYM=0, LINESTYLE=0 oyy1= oyy2+2.0 oyy2= oyy1+h ENDIF ENDFOR ENDIF ; Draw the Guide Telescope dumps: yb = 0. & yt = 5. OPLOT,[t1,t2],[yb,yb],PSYM=0,LINESTYLE=0 OPLOT,[t1,t2],[yt,yt],PSYM=0,LINESTYLE=0 XYOUTS,t1,yb+2.5-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'GT Dumps ' gt_struct= {x1:0D, x2:0D, apid:'', rate:0L} gt_data= gt_struct ;IF (DATATYPE(stime_gt) NE 'UND') THEN BEGIN IF (DATATYPE(stime_gt) EQ 'DOU') THEN BEGIN wcnt= N_ELEMENTS(sc_gt) & w= INDGEN(wcnt) IF (schedv.sc EQ 1) THEN w= WHERE(sc_gt EQ 'A' OR sc_gt EQ 'AB', wcnt) IF (schedv.sc EQ 2) THEN w= WHERE(sc_gt EQ 'B' OR sc_gt EQ 'AB', wcnt) IF (wcnt GT 0) THEN BEGIN FOR i= 0, N_ELEMENTS(stime_gt(w))-1 DO BEGIN x1 = (stime_gt(w(i)) - daystart) / 3600D;** tai -> hrs since start STARTDIS day x2 = (etime_gt(w(i)) - daystart) / 3600D;** tai -> hrs since start STARTDIS day true_x1= x1 ; so that if part of hk-dump is before start of schedule, it is counted (for SSR1) x1 = x1 > !X.CRANGE(0) x2 = x2 < !X.CRANGE(1) y1 = yb y2 = y1 + 5.0 ;** add thickness of line IF (x2 GT x1) THEN BEGIN ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) ;POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2] POLYFILL, [x1,x2,x2,x1], [y1+0.2,y1+0.2,y2-0.3,y2-0.3],COLOR=155 ;XYOUTS,x1+(x2-x1)/2,yb+2.5-dy, apid_gt(w(i)), FONT=-1,ALIGN=1.0,CHARSIZE=charsize,COLOR=0 ;XYOUTS,x1+(x2-x1)/2,yb+2.2-dy, apid_gt(w(i))+' '+sc_gt(w(i)), FONT=-1,ALIGN=0.5, $ ; CHARSIZE=charsize,COLOR=7,CLIP=[x1,y1,x2,y2],NOCLIP=0 ;WRITE_IN_BOX,x1,x2,y1,y2, apid_gt(w(i))+' '+sc_gt(w(i)), COLOR=7 gtrate= ' ('+STRTRIM(rate_gt(w(i)),2)+' bps)' ;WRITE_IN_BOX,x1,x2,y1,y2, apid_gt(w(i))+' '+sc_gt(w(i))+gtrate, COLOR=7 WRITE_IN_BOX,x1,x2,y1,y2, apid_gt(w(i))+' '+sc_gt(w(i))+gtrate, COLOR=0 gt_struct.x1= true_x1 gt_struct.x2= x2 gt_struct.apid= apid_gt(w(i)) gt_struct.rate= rate_gt(w(i)) gt_data= [gt_data, gt_struct] ENDIF ENDFOR ENDIF ENDIF ;-------- END FIRST PLOT --------------- ;-------- SECOND PLOT --------------- ; ; Make the plot frame, but don't plot the X axis. ; !Y.MARGIN = [4, 0] ;** bottom and top margin in chars ;rows = 100 ;** yrange [0,100] rows = 105 ;** yrange [0,104] ; AEE 6/17/03 PLOT,[t1,t2],[0,rows-1],/NODATA,XSTYLE=5,YSTYLE=1,YTICKS=1, $ YTICKNAME=REPLICATE(' ',2),XMARGIN=[15,4],CHARSIZE=charsize, $ XTICK_GET=XTICKS,PSYM=0,LINESTYLE=0 ; ; Plot the X axis with time format labels. ; AXIS,XAXIS=0,XSTYLE=1,XTICKNAME=HOURS+':'+MM+':'+SS,CHARSIZE=charsize, $ XTITLE=xtitle AXIS,XAXIS=1,XSTYLE=1,XTICKNAME=REPLICATE(' ',30) dy = !D.Y_CH_SIZE * charsize / (3 * !Y.S(1) * !D.Y_SIZE) ; mark day boundaries with gray background ;cols = [0,80] cols = [0,100] ; AEE - 6/17/03 ;y1 = 15.0 y1 = 40.0 ;y2 = 75.0 y2 = 100.0 done = 0 x1 = 24.0 x2 = 48.0 < t2 i = 1 IF (x1 GE t2) THEN done = 1 WHILE (NOT(done)) DO BEGIN ind = (i MOD 2) POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], COLOR=cols(ind) x1 = x2 x2 = (x2 + 24.0) < t2 i = i + 1 IF (x1 GE t2) THEN done = 1 ENDWHILE prev_hr = 24 ;mins = mins + (prev_hr*60) ;** add n hr for calculating preceeding hours buffer usage secs = secs + (prev_hr*3600D) ;** add n hr for calculating preceeding hours buffer usage ;tmsubmode = INTARR(mins)+1 ; tm submode array 1 element per minute of plotting window tmsubmode = INTARR(secs)+1 ; tm submode array 1 element per second of plotting window ;** initialize it to LR SCI id = WHERE(kap_resource_names EQ "TLM_SUBMODE") & id = id(0) ind= -1 IF (DATATYPE(kap_resource_arr) EQ 'STC') THEN $ ind = WHERE(kap_resource_arr.id EQ id) IF (ind(0) GE 0) THEN BEGIN tlm_submode = kap_resource_arr(ind) ind = SORT([tlm_submode.startime]) ;** sort by start time tlm_submode = tlm_submode(ind) tmsubmode(*) = tlm_submode(N_ELEMENTS(tlm_submode)-1).type ENDIF ; ; Draw the lines for SPACECRAFT_MANEUVER & Plot. ; mb= 100.0 ;(top of the OSes section) ;mt= mb+5.0 mt= mb+4.0 OPLOT,[t1,t2],[mb,mb],PSYM=0,LINESTYLE=0 XYOUTS,t1,mt-1.0-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'S/C Maneuver & ' XYOUTS,t1,mb+1.0-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'SCIP DoorClosures' id = WHERE(kap_resource_names EQ "SPACECRAFT_MANEUVER") & id = id(0) ind= -1 IF (DATATYPE(kap_resource_arr) EQ 'STC') THEN $ ind = WHERE(kap_resource_arr.id EQ id) IF (ind(0) GE 0) THEN BEGIN sc_maneuver = kap_resource_arr(ind) ind = SORT([sc_maneuver.startime]) ;** sort by start time sc_maneuver = sc_maneuver(ind) FOR i = 0,N_ELEMENTS(sc_maneuver)-1 DO BEGIN x1 = (sc_maneuver(i).startime - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x2 = (sc_maneuver(i).endtime - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x1 = x1 > !X.CRANGE(0) x2 = (x2 < !X.CRANGE(1)) y1 = mb y2 = mt ;** add thickness of line IF (x2 GE x1) THEN BEGIN ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) ;POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2] POLYFILL, [x1,x2,x2,x1], [y1,y1,y2-0.4,y2-0.4] ENDIF ENDFOR ENDIF ; AEE - 6/3/03 - Added color coded SCIP close-door periods to the S/C Maneuver plot. ; NOTE: At this point, for each instrument (EUVI, COR1, COR2) there MUST be the same number of ; open-doors as are the close-doors and in sorted order: cind = [ [1,6], [2,7], [3,8], [4,9], [5,10], [255,170] ] ;** EUVI, COR1, COR2, HI1, HI2, unk ; Plot EUVI close-door periods: ;IF (DATATYPE(cdoor_euvi) EQ 'DOU' AND schedv.sc NE 0) THEN BEGIN ; leave out 'UND' and 'INT' (cdoor_euvi=0) datatypes IF (DATATYPE(cdoor_euvi) EQ 'DOU') THEN BEGIN ; leave out 'UND' and 'INT' (cdoor_euvi=0) datatypes wcnt= N_ELEMENTS(sc_euvi) & w= INDGEN(wcnt) IF (schedv.sc EQ 1) THEN w= WHERE(sc_euvi EQ 'A', wcnt) IF (schedv.sc EQ 2) THEN w= WHERE(sc_euvi EQ 'B', wcnt) ;FOR i = 0,N_ELEMENTS(cdoor_euvi)-1 DO BEGIN FOR i = 0,wcnt-1 DO BEGIN x1 = (cdoor_euvi(w(i)) - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x2 = (odoor_euvi(w(i)) - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x1 = x1 > !X.CRANGE(0) x2 = (x2 < !X.CRANGE(1)) ;y1 = mb ;y2 = y1+1.0 ;** thickness of EUVI y1= mb y2 = y1+1.0 ;** thickness of EUVI IF (x2 GE x1) THEN BEGIN ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVIC))(0) POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], COLOR= cind(0,0) ;XYOUTS,x1+(x2-x1)/2,y1+0.4,sc_euvi(w(i)), FONT=-1,ALIGN=0.5,CHARSIZE=charsize/2 WRITE_IN_BOX,x1,x2,y1,y2, sc_euvi(w(i)) ENDIF ENDFOR ENDIF ; Plot COR1 close-door periods: ;IF (DATATYPE(cdoor_cor1) EQ 'DOU' AND schedv.sc NE 0) THEN BEGIN IF (DATATYPE(cdoor_cor1) EQ 'DOU') THEN BEGIN wcnt= N_ELEMENTS(sc_cor1) & w= INDGEN(wcnt) IF (schedv.sc EQ 1) THEN w= WHERE(sc_cor1 EQ 'A', wcnt) IF (schedv.sc EQ 2) THEN w= WHERE(sc_cor1 EQ 'B', wcnt) ;FOR i = 0,N_ELEMENTS(cdoor_cor1)-1 DO BEGIN FOR i = 0,wcnt-1 DO BEGIN x1 = (cdoor_cor1(w(i)) - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x2 = (odoor_cor1(w(i)) - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x1 = x1 > !X.CRANGE(0) x2 = (x2 < !X.CRANGE(1)) ;y1 = mb+2.0 ;y2 = y1+1.0 ;** thickness of COR1 ;y1 = y2+0.4 y1 = mb+1.4 y2 = y1+1.0 ;** thickness of COR1 IF (x2 GE x1) THEN BEGIN ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVIC))(0) POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], COLOR= cind(0,1) ;XYOUTS,x1+(x2-x1)/2,y1+0.4,sc_cor1(w(i)), FONT=-1,ALIGN=0.5,CHARSIZE=charsize/2 WRITE_IN_BOX,x1,x2,y1,y2, sc_cor1(w(i)) ENDIF ENDFOR ENDIF ; Plot COR2 close-door periods: ;IF (DATATYPE(cdoor_cor2) EQ 'DOU' AND schedv.sc NE 0) THEN BEGIN IF (DATATYPE(cdoor_cor2) EQ 'DOU') THEN BEGIN wcnt= N_ELEMENTS(sc_cor2) & w= INDGEN(wcnt) IF (schedv.sc EQ 1) THEN w= WHERE(sc_cor2 EQ 'A', wcnt) IF (schedv.sc EQ 2) THEN w= WHERE(sc_cor2 EQ 'B', wcnt) ;FOR i = 0,N_ELEMENTS(cdoor_cor2)-1 DO BEGIN FOR i = 0,wcnt-1 DO BEGIN x1 = (cdoor_cor2(w(i)) - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x2 = (odoor_cor2(w(i)) - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x1 = x1 > !X.CRANGE(0) x2 = (x2 < !X.CRANGE(1)) ;y1 = mt-1.0 ;y2 = y1+1.0 ;** thickness of COR2 ;y1 = y2+0.4 y1 = mb+2.8 y2 = y1+1.0 ;** thickness of COR2 IF (x2 GE x1) THEN BEGIN ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVIC))(0) POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], COLOR= cind(0,2) ;XYOUTS,x1+(x2-x1)/2,y1+0.4,sc_cor2(w(i)), FONT=-1,ALIGN=0.5,CHARSIZE=charsize/2 WRITE_IN_BOX,x1,x2,y1,y2, sc_cor2(w(i)) ENDIF ENDFOR ENDIF ;help,doors,pdoors,sc_euvi,sc_cor1,sc_cor2,cdoor_euvi,odoor_euvi,cdoor_cor1,odoor_cor1,cdoor_cor2,odoor_cor2 ;stop IF (DATATYPE(defined_os_arr) NE 'STC' OR $ ; AEE 2/17/04 - Added DATATYPE(os_arr) NE 'STC') THEN GOTO, CONT ; AEE 3/25/04: ; Remove OSes that are not in os_arr from defined_os_arr (a os_arr element maybe ; deleted by not removed from defined_os_arr) for calling IMAGE_DESTINATION: osnums= os_arr(UNIQ_NOSORT(os_arr.os_num)).os_num ok_ind= -1 ; AEE 4/6/04 - make sure the correct HI seq record is used. ok_defined= WHERE(defined_os_arr.num_images GT 0) ;for HI seq, remove the extra/empty entry. tmp_defined= defined_os_arr(ok_defined) FOR i= 0, N_ELEMENTS(osnums)-1 DO BEGIN tmp= WHERE(tmp_defined.os_num EQ osnums(i),wcnt) ; AEE 4/6/04 IF (wcnt GT 0) THEN ok_ind= [ok_ind,tmp(0)] ENDFOR ok_ind= ok_ind(1:*) os_dest = IMAGE_DESTINATION(tmp_defined(ok_ind)) ; AEE 4/6/04 ; AEE 3/3/04 - added S1RT (SSR1RT) APID to image_destination. ; for each OS in the defined_os_arr, an array of 6 values are returned one for each APID. ; The values (for downlink channel) correspond to: [SSR1, SSR2, RT, SW, GT, S1RT] ; Each value can have a range of 0 to 4 except for the first (SSR1) that can have a range ; of 0-27 (7 to 27 is used to preserve the original value fo SSR1): ; 0 = No image is dowlinked on this channel. ; 1 = 1st APID (can be the only one) specified by IP functions as the downlink channel ; 2 = 2nd APID specified by IP functions as the downlink channel. ; 3 = 3rd APID specified by IP functions as the downlink channel. ; 4 = 4th APID specified by IP functions as the downlink channel. ; 5 = 5th APID specified by IP functions as the downlink channel. ; 6 = 6th APID specified by IP functions as the downlink channel. ; ; Following only applies to SSR1: ; 7-13 = RT image is also added to SSR1 by default. ; 7 = No explicit SSR1 image from PT ; 8 = explicit SSR1 image from PT appeared 1st ; 9 = explicit SSR1 image from PT appeared 2nd ; 10 = explicit SSR1 image from PT appeared 3rd ; 11 = explicit SSR1 image from PT appeared 4th ; 12 = explicit SSR1 image from PT appeared 5th ; 13 = explicit SSR1 image from PT appeared 6th ; 14-20 = SW image is also added to SSR1 by default. ; 21-27 = RT and SW images are also added to SSR1 by default. ; ;col_ind = [ [1,5], [2,6], [3,7], [4,8], [255,170] ] ;** c1, c2, c3, eit, unk col_ind = [ [1,6], [2,7], [3,8], [4,9], [5,10], [255,170] ] ;** EUVI, COR1, COR2, HI1, HI2, unk ; Draw the lines for the OS's ; IF (DATATYPE(os_arr) EQ 'INT') THEN GOTO, CONT os_arr2 = os_arr uniq_os_arr2 = os_arr2(UNIQ_NOSORT([os_arr2.os_num])) uniq_os_arr2 = uniq_os_arr2(SORT(uniq_os_arr2.os_num)) num_os = N_ELEMENTS(uniq_os_arr2) ;yy1 = 15.0 yy1 = 40.0 ; AEE - 6/17/03 ;yy2 = 75.0 yy2 = 100.0 ; AEE - 6/17/03 height = (yy2 - yy1)/num_os os_ypos = FLTARR(num_os+1) os_ypos(N_ELEMENTS(os_ypos)-1) = yy2 os_y = {os_y, pos:0.0, os_num:0L} os_yarr = REPLICATE(os_y, num_os) j = 0 FOR i = yy1, yy2, height DO BEGIN os_ypos(j) = i OPLOT, [t1,t2], [i,i], PSYM=0, LINESTYLE=0 IF (ROUND(i) LT yy2) THEN BEGIN ; XYOUTS, t1, i+height/2-dy, FONT=-1, ALIGN=1, CHARSIZE=charsize, $ ; 'OS_'+STRING(FIX(uniq_os_arr2(j).os_num),'(I4.4)')+' ' ;str= 'OS_'+STRTRIM(STRING(FIX(uniq_os_arr2(j).os_num)),2)+' ' str= 'OS_'+STRING(FIX(uniq_os_arr2(j).os_num),'(I4.4)')+' ' IF (uniq_os_arr2(j).os_lp EQ 5 OR uniq_os_arr2(j).os_lp EQ 6) THEN str= 'SEQ '+ str IF (uniq_os_arr2(j).os_lp EQ 2) THEN str= 'DRK '+ str ; AEE 6/12/03 IF (uniq_os_arr2(j).os_lp EQ 3) THEN str= 'LED '+ str ; AEE 6/12/03 IF (uniq_os_arr2(j).os_lp EQ 4) THEN str= 'CON '+ str ; AEE 6/12/03 IF (uniq_os_arr2(j).os_lp EQ 0) THEN str= 'DBL '+ str ; AEE 10/7/03 IF (uniq_os_arr2(j).os_lp EQ 1) THEN str= 'SKY '+ str ; AEE 10/7/03 sind= WHERE(os_dest.os_num EQ uniq_os_arr2(j).os_num, scnt) ; AEE - 7/28/03 IF (scnt GT 0) THEN BEGIN IF (os_dest(sind(0)).summed) THEN str= 'Sum'+str IF (NOT os_dest(sind(0)).summed) THEN BEGIN fho= WHERE(defined_os_arr.os_num EQ uniq_os_arr2(j).os_num) ho= WHERE(defined_os_arr(fho(0)).ip(defined_os_arr(fho(0)).iptable).steps EQ 5, hocnt) IF (hocnt GT 0) THEN str= 'Hdr'+str ENDIF ENDIF ;sync= 0 ;os_ind= WHERE(defined_os_arr.os_num EQ uniq_os_arr2(j).os_num, ocnt) ;IF (ocnt GT 0) THEN sync= defined_os_arr(os_ind(0)).sync ;IF (sync EQ 1) THEN BEGIN ; XYOUTS, t1, i+height/2-dy, FONT=-1, ALIGN=1, CHARSIZE=charsize, str, $ ; COLOR= col_ind(0,uniq_os_arr2(j).os_tele) ;ENDIF ELSE BEGIN ; XYOUTS, t1, i+height/2-dy, FONT=-1, ALIGN=1, CHARSIZE=charsize, str ;ENDELSE XYOUTS, t1, i+height/2-dy, FONT=-1, ALIGN=1, CHARSIZE=charsize, str os_yarr(j).pos = i os_yarr(j).os_num = uniq_os_arr2(j).os_num ENDIF j=j+1 ENDFOR ; ; ; Plot the OS's ; XYOUTS, 0.98,0.47, "EUVI", COLOR=col_ind(0,0), /NORMAL ,ORIENTATION=270,CHARSIZE=2,CHARTHICK=2.0 XYOUTS, 0.98,0.42, "COR1", COLOR=col_ind(0,1), /NORMAL ,ORIENTATION=270,CHARSIZE=2,CHARTHICK=2.0 XYOUTS, 0.98,0.36, "COR2", COLOR=col_ind(0,2), /NORMAL ,ORIENTATION=270,CHARSIZE=2,CHARTHICK=2.0 XYOUTS, 0.98,0.30, "HI1", COLOR=col_ind(0,3), /NORMAL ,ORIENTATION=270,CHARSIZE=2,CHARTHICK=2.0 XYOUTS, 0.98,0.265, "HI2", COLOR=col_ind(0,4), /NORMAL,ORIENTATION=270,CHARSIZE=2,CHARTHICK=2.0 ; AEE 7/16/03 - added lp and seq_cnt expand_os= {expand_os, os_num:0L, tele:0, start:0D, stop:0D, ccd_start:0D, ccd_stop:0D, $ orig_ccd_stop:0D, proc_times:'',proc_time:0D, sizes:'', size:0L, lp:0, $ img_cnt:0L, seq_cnt:0, apid:'', sfn:'', os_start:0D, orig_start:0D, $ same_seq_start_time:0D} expanded= expand_os no_ho_expanded= expand_os cx1= (convert_coord([(convert_coord([!X.CRANGE(0),0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) cx2= (convert_coord([(convert_coord([!X.CRANGE(1),0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) cy1= (convert_coord([(convert_coord([!Y.CRANGE(0),0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) cy2= (convert_coord([(convert_coord([!Y.CRANGE(1),0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) IF (!X.CRANGE(1)-!X.CRANGE(0) LE 0.5) THEN $ solid= 0 $ ;false - for time spans of 1/2 hr or less, plot using dots and solid (CCD). ELSE $ solid= 1 ;True - for time spans of more than 1/2 hr, plot everyting in solid colors so they can be seen FOR i = 0, num_os-1 DO BEGIN ;** for every unique os_num good = WHERE(os_arr.os_num EQ uniq_os_arr2(i).os_num AND $ os_arr.os_images GT 0) ; AEE - 01/27/03 - incase HI1 or HI2 of HI seq is not selected ;** each telescope is a different color tele = 5 ;** default color is white os_ind = WHERE(defined_os_arr.os_num EQ uniq_os_arr2(i).os_num) IF (os_ind(0) GE 0) THEN telescope = defined_os_arr(os_ind).tele IF (os_ind(0) GE 0) THEN cadences= defined_os_arr(os_ind).cadence ; AEE - 01/15/03 pccd_x1= -1 ; AEE - Dec 23, 02: use to plot the ccd readout solid line of a previous image ; since the pattern from the next image may overwrite it. ;** sort on start time to plot IF (N_ELEMENTS(good) GT 1) THEN good = good(SORT([os_arr(good).os_start])) FOR j=0, N_ELEMENTS(good)-1 DO BEGIN ;** for every occurance of this os_num os = os_arr(good(j)) tele= os.os_tele y1 = os_ypos(i) y2 = os_ypos(i+1) x1 = os.os_start x2 = os.os_stop ; AEE - DEC 23, 02: Calculate times per single image (in case of PW_SEQ and HI_SEQ): nimages= os.os_images pre_proc1= os.os_pre_proc_time/nimages pre_proc= os.os_pre_proc_time/nimages ccd_rot1= os.os_ro_time/nimages img_proc1= os.os_proc_time/nimages os_size1= os.os_size/nimages dur1= os.os_duration/nimages IF (os.os_lp EQ 5) THEN BEGIN ; For a SCIP seq, since polar positions may be different, the exptimes ; may also be different resulting in different pre_proc_time for different ; images in the seq (also done in expand_seq.pro): tel= os.os_tele ind= WHERE(defined_os_arr.os_num EQ os.os_num AND defined_os_arr.num_images EQ nimages) exptab= defined_os_arr(ind(0)).exptable fw= defined_os_arr(ind(0)).fw(0) pw= defined_os_arr(ind(0)).pw(0:nimages-1) ;;exptimes= defined_os_arr(ind(0)).ex(tel,exptab,fw,pw)/1024.0 ; change units to SCIP seconds. ;exptimes= defined_os_arr(ind(0)).ex(tel,exptab,fw,pw)/1000.0 ; units are physical seconds. ;a_pre_proc_time= os.os_setup_time/nimages ;pre_proc_ime per image minus exptime. ;pre_proc= exptimes + a_pre_proc_time setup_times= FLTARR(nimages) pre_proc= FLTARR(nimages) ;pre_time= OS_GET_PRE_PROC_TIME(defined_os_arr(ind(0)),0,ro_time,setup_time,fil_time,pol_time) pre_proc(0)= OS_GET_PRE_PROC_TIME(defined_os_arr(ind(0)),0,ro_time,setup_time,fil_time,pol_time) setup_times(0)= setup_time FOR nj= 1, nimages-1 DO BEGIN ;pre_time= OS_GET_PRE_PROC_TIME(defined_os_arr(ind(0)),nj,ro_time,setup_time,fil_time,pol_time) pre_proc(nj)= OS_GET_PRE_PROC_TIME(defined_os_arr(ind(0)),nj,ro_time,setup_time,fil_time,pol_time) setup_times(nj)= setup_time - fil_time IF (pw(nj) EQ pw(nj-1)) THEN setup_times(nj)= setup_time - pol_time ENDFOR ;pre_proc= exptimes + setup_times ENDIF ; Note: Now only first image of a SCIP seq and all of SCIP images that are not sequences have ; polar/quad_selector and filter (EUVI) times added to the setup time. In the other words, ; We assume a filter/plor change for each non-sequence scheduled image and the first image ; of SCIP seq. Note that HI telescopes don't use filter/polar so they are ok. Also, Images ; 2-N of a SCIP seq only have polar/quad time added if there was a movement. ; Done in get_os_db_stats.pro, schedule_plot.pro, expand_seq.pro. IF (os.os_lp EQ 6) THEN BEGIN ; A SCIP seq (with same cadence between all images) or a HI seq. ; All exptimes (hence pre_proc_times) are the same: pre_proc= REPLICATE(pre_proc1,nimages) ENDIF cadence= cadences(0) ; AEE - 01/24/03 IF (os.os_lp EQ 6) THEN $ ; AEE - 01/23/03 - to pickup either HI1 or HI2 cadence cadence= (cadences(WHERE(telescope EQ tele)))(0) ; See if HI seq is a summed seq (only an HI summed seq will have different steps in ip and ipd): tind= WHERE(os.os_num EQ defined_os_arr.os_num AND os.os_tele EQ defined_os_arr.tele) def_os= defined_os_arr(tind) iptable= def_os.iptable tmp= WHERE(ip(iptable).steps NE ipd(iptable).steps, nind) ;print,iptable,nind ;help,/st,os.os_num ;print,def_os.ip(iptable).steps ;stop expand_os.apid= '' ; clear it if set previously FOR kk=0,nimages-1 DO BEGIN ; for PW_SEQ & HI_Seq, plot each image in the sequence IF (nind GT 0) THEN BEGIN IF (kk EQ 0) THEN BEGIN ; First image's table def_os.ip(iptable).steps= ipd(iptable).steps(2:*) expand_os.apid= '' ; clear it (if set last time). ;print,expand_os.os_num ;print,def_os.os_num ;print,'apid=', def_os.ip(iptable).steps(0) ;expand_os.apid= STRTRIM(def_os.ip(iptable).steps(0),2) ; 40 to 44 ;stop ENDIF ;IF (kk GT 0 AND kk LT def_os.num_images-1) THEN BEGIN IF (kk GT 0 AND kk LT def_os.num_images-2) THEN BEGIN ; Middle image's table desc= ip_arr(ipd(iptable).steps(0)).ip_description table_num= FIX(STRMID(desc,STRPOS(desc,'Table ')+6,2)) def_os.ip(iptable).steps= ipd(table_num).steps ;hisam= WHERE(ipd(table_num).steps EQ 15,hisam_cnt) ;IF (hisam_cnt GT 0) THEN BEGIN ; def_os.ip(iptable).steps(1:*)= -1 ; def_os.ip(iptable).steps(1)= 6 ; set steps to just HISAM and NoCompression ;print,'HISAM: ',def_os.ip(iptable).steps ;ENDIF ;print,'apid=', ipd(table_num).steps(0) expand_os.apid= STRTRIM(def_os.ip(iptable).steps(0),2) ; 40 to 44 hisam= WHERE(ipd(table_num).steps EQ 15,hisam_cnt) IF (hisam_cnt EQ 0) THEN expand_os.apid= expand_os.apid+'Drop' ; so expand_oses don't keep these. ;print,'apid=', def_os.ip(iptable).steps(0) ;print,'apid=', expand_os.apid ;stop ENDIF IF (kk EQ def_os.num_images-1) THEN BEGIN ; Last image's table desc= ip_arr(ipd(iptable).steps(1)).ip_description table_num= FIX(STRMID(desc,STRPOS(desc,'Table ')+6,2)) def_os.ip(iptable).steps= ipd(table_num).steps expand_os.apid= '' ; clear it (if set last time). ;print,'apid=', def_os.ip(iptable).steps(0) ;expand_os.apid= STRTRIM(def_os.ip(iptable).steps(0),2) ; 40 to 44 if (def_os.lp eq 6) then begin ; for Hi summed seq, last image uses IP_32HI, IP-32LLO and ; maybe additionally HI1SPW or HI2SPW, so keep the apids ; for each of these destinations and in expand_oses.pro ; assign them for each image: hilo= where(def_os.ip(iptable).steps eq 120 or $ def_os.ip(iptable).steps eq 121, hilo_cnt) if (hilo_cnt gt 0) then begin apids= where(def_os.ip(iptable).steps ge 40 and $ def_os.ip(iptable).steps le 44, apids_cnt) for ap=0, apids_cnt-1 do expand_os.apid= expand_os.apid+ $ ','+strtrim(def_os.ip(iptable).steps(apids(ap)),2) expand_os.apid= strmid(expand_os.apid,1,20) ; remove first ',' endif endif ;help,/st,expand_os ;stop ENDIF img_proc1= GET_IP_TIME(def_os) ENDIF pre_proc1= pre_proc(kk) ; AEE - 02/06/03: ; For a SEQ, if cadence is 0 (default), it means to schedule images in the sequence ; as close together as possible, otherwise, schedule them according to the cadence. ; Also if cadence=0, figure it out and assign it to the os_arr and defined_os_arr ; so that cadence used would show up in IPT files, etc.: ; NOTE: candence assignment is already done in get_os_db_stats.pro, now. ;x1= os.os_start + cadence * kk ; for q SCIP seq, cadence (pre_proc_time+ccd_readout) may be different between differnt images: IF (kk EQ 0) THEN BEGIN ; Ture for all images. x1= os.os_start ENDIF ELSE BEGIN ; True only for a SCIP or HI seq image. IF (os.os_cadence EQ 0.0) THEN $ x1= os.os_start + TOTAL(pre_proc(0:kk-1)) + ccd_rot1 * kk $ ELSE $ x1= os.os_start + cadence * kk ; use the provided cadence to separate images in the seq. ENDELSE x2= x1 + pre_proc1 + ccd_rot1 + img_proc1 ;help,x1,x2 orig_ccd_stop= x1 + pre_proc1 + ccd_rot1 ; AEE 7/17/03 ; AEE - Dec 20, 02: Display the CCD readout time as solid and the rest as a dotted patern: ccd_x1= x1 + pre_proc1 ; AEE - Dec 23, 02 ccd_x2= ccd_x1 + ccd_rot1 ; times are in TAI format, convert to hours since start STARTDIS day x1 = (x1 - daystart) / 3600D x2 = (x2 - daystart) / 3600D ccd_x1 = (ccd_x1 - daystart) / 3600D ccd_x2 = (ccd_x2 - daystart) / 3600D orig_x2= x2 orig_ccd_x2= ccd_x2 expand_os.os_start= os.os_start expand_os.orig_start= x1 IF (kk EQ 0) THEN fst_image_start_time= x1 expand_os.same_seq_start_time= fst_image_start_time x1 = x1 > !X.CRANGE(0) ccd_x1 = ccd_x1 > x1 x2 = x2 < !X.CRANGE(1) ccd_x2 = ccd_x2 < x2 ccd_x2 = ccd_x1 > ccd_x2 ; AEE - Dec 30, 02 ;print,'x1, x2, ccdx1, ccdx2 =',x1, x2, ccd_x1, ccd_x2 IF (x2 GT x1) THEN BEGIN ;** make sure line is at least 1 pixel wide temp_x1 = x1 temp_x2 = x2 x2 = x2 > $ (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) ; x1 = x1 > $ ; (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) temp_ccd_x2 = ccd_x2 ccd_x2 = ccd_x2 > $ (convert_coord([(convert_coord([ccd_x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) temp_ccd_x1 = ccd_x1 ccd_x1 = ccd_x1 > $ (convert_coord([(convert_coord([ccd_x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) ccd_x1 = ccd_x1 > x1 ;ccd_x1 = ccd_x1 > x1 < x2 ccd_x2 = ccd_x2 < x2 ;help,x1,x2 ;help,ccd_x1,ccd_x2 ;stop pat=bytarr(4,4) pat(2,2)= col_ind((j MOD 2),tele) IF (solid) THEN $ POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], COLOR= col_ind((j MOD 2),tele) $ ELSE $ POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], pat=pat OPLOT, [x1,x1,x1,x1], [y1,y1,y2,y2], COLOR= col_ind((j MOD 2),tele) ; mark ccd-clear IF ((os.os_lp EQ 5 OR os.os_lp EQ 6) AND $ !X.CRANGE(1)-!X.CRANGE(0) LE 0.5) THEN BEGIN ; a Seq plots of 1/2 hr or less ; either a SCIP Seq(5) or HI Seq (6) ;mark='Seq '+STRTRIM(STRING(kk+1),2)+' of '+STRTRIM(STRING(os.os_images),2) mark= STRTRIM(STRING(kk+1),2)+' of '+STRTRIM(STRING(os.os_images),2) XYOUTS, (x1+x2)/2.0, (y1+y2)/2.0, mark, /DATA, $ ORIENTATION=90, ALIGNMENT=0.5, CLIP=[x1,y1,x2,y2], NOCLIP=0 ENDIF ; AEE - Dec 23, 02: plot the ccd readout solid line of a previous image ; since the pattern from the next image may have overwritten it: ; Also S/C A, B or AB id. IF (NOT solid AND pccd_x1 NE -1) THEN BEGIN pccd_x1 = pccd_x1 < pccd_x2 ;help,pccd_x1 ;stop POLYFILL, [pccd_x1,pccd_x2,pccd_x2,pccd_x1], [py1,py1,py2,py2], $ COLOR=col_ind(pcolor,ptele) OPLOT, [px1,px1,px1,px1], [py1,py1,py2,py2], COLOR= col_ind(pcolor,ptele) ; mark ccd-clear ; Display is for both S/C A and B for 3 hours or less display-ranage. ; For a seq, only display it for the middle image: IF (pccd_x1 LT pccd_x2 AND schedv.sc EQ 0 AND $ (!X.CRANGE(1)-!X.CRANGE(0) LE 3.0)) THEN BEGIN sze= 1.0 IF (psc EQ 'AB' AND (py2-py1) LE 2.5) THEN sze= 0.7 IF (nimages GT 1) THEN BEGIN ; image part of a sequence IF (kk EQ nimages/2+1) THEN BEGIN ;** mark the image with Either A, B, or AB ;XYOUTS, (pccd_x1+pccd_x2)/2.0, py1+(py2-py1)/2, psc, /DATA, $ ;alignment=0.5, ORIENTATION=90, CLIP=[px1,py1,px2,py2], NOCLIP=0 XYOUTS, pccd_x2, py1+(py2-py1)/2, psc, /DATA, $ alignment=0.5, ORIENTATION=90, CLIP=[cx1,cy1,cx2,cy2], NOCLIP=0, SIZE=sze ENDIF ENDIF ELSE BEGIN ; image not part of a sequence ;IF (kk EQ nimages/2) THEN BEGIN ;** mark the image with Either A, B, or AB XYOUTS, pccd_x2, py1+(py2-py1)/2, psc, /DATA, $ alignment=0.5, ORIENTATION=90, CLIP=[cx1,cy1,cx2,cy2], NOCLIP=0,SIZE=sze ;ENDIF ENDELSE ENDIF ENDIF ; Plot current image CCD and S/C info: IF(ccd_x1 LT x2) THEN BEGIN ; AEE - Dec 20, 02: Don't plot ccd if it is out of current plot-range ;help,ccd_x1,x2 ;stop IF (NOT solid) THEN $ POLYFILL, [ccd_x1,ccd_x2,ccd_x2,ccd_x1], [y1,y1,y2,y2], COLOR=col_ind((j MOD 2),tele) OPLOT, [x1,x1,x1,x1], [y1,y1,y2,y2], COLOR=col_ind((j MOD 2),tele) ; mark ccd-clear ; add schedv.sc EQ 0 (S/C A, B, or AB) info for current image: sze= 1.0 IF (os.sc EQ 'AB' AND (y2-y1) LE 2.5) THEN sze= 0.7 IF (ccd_x1 LT ccd_x2 AND schedv.sc EQ 0 AND $ (!X.CRANGE(1)-!X.CRANGE(0) LE 3.0) AND kk EQ nimages/2) THEN BEGIN XYOUTS, ccd_x2, y1+(y2-y1)/2, os.sc, /DATA, $ alignment=0.5, ORIENTATION=90, CLIP=[cx1,cy1,cx2,cy2], NOCLIP=0, SIZE=sze ENDIF ENDIF pccd_x1= ccd_x1 pccd_x2= ccd_x2 py1= y1 py2= y2 px1= x1 px2= x2 pcolor= (j MOD 2) ptele= tele ; *** correct tele(0) for HI Seq here and in POLYFILL statement(s). psc= os.sc ;ENDIF x1= temp_x1 x2= temp_x2 ccd_x1= temp_ccd_x1 ccd_x2= temp_ccd_x2 ENDIF expand_os.os_num= os.os_num expand_os.tele= os.os_tele expand_os.start= x1 expand_os.stop= x2 expand_os.ccd_start= ccd_x1 expand_os.ccd_stop= ccd_x2 expand_os.orig_ccd_stop= orig_ccd_stop expand_os.proc_time= img_proc1 IF (DATATYPE(multi_apid) EQ 'UND') THEN BEGIN PRINT,'' PRINT,'WARNING: PT_OS_SIZE for all OSes in .IPT file should be set to 0 if no' PRINT,' PT_OS_SIZES is present' PRINT,' OR PRINT,' all previosly declared common_blocks should be removed prior to' PRINT,' start of schedule.' PRINT,'' STOP ENDIF ; Note: If HI1 and HI2 both exist in a HI-seq, there will be two OSes (the same ; value but the second with a minus sign) in multi_apid. Since both of these OSes ; will have the identical PT_OS_SIZES info that covers both HI1 and HI2 (seperated ; with &), the multi_apid with the minus OS is not needed and is ignored. ind= WHERE(multi_apid.os_num eq os.os_num) sizes= STR_SEP(multi_apid(ind).sizes, '&') ; separate HI1 fro HI2 sizes if both in a seq. ; See if HI1 and HI2 are both present in a HI-seq and, if so, use the correct size: IF (N_ELEMENTS(sizes) EQ 2 AND os.os_tele EQ 4) THEN $ sizes= sizes(1) $ ELSE $ sizes= sizes(0) sizes= STR_SEP(sizes,',') ; separate sizes for each image in the seq. Each one can be one ; or more sizes, separated by a space, depending on # of APIDs expand_os.sizes= sizes(kk) iptimes= STR_SEP(multi_apid(ind).proc_times,',') expand_os.proc_times= iptimes(kk) ;apids= STR_SEP(multi_apid(ind).apid,',') ;apids= STR_SEP(summed_apids(ind).apid,',') ;expand_os.apid= apids(kk) ;help,sizes,expand_os,apids ;stop expand_os.lp= os.os_lp expand_os.seq_cnt= kk+1 ; starting at 1 IF (expanded(0).os_num EQ 0) THEN $ expanded= expand_os $ ; first time ELSE $ expanded= [expanded,expand_os] ; We need to remove "Header-Only" images from showing up in any of the APIDs/channels ; but since HI summed sequences may also have "Header-Only" step(s), don't use ; those (identified by os_dest.summed=1): dw= WHERE(os_dest.os_num EQ os.os_num, dwcnt) summed= os_dest(dw(0)).summed w= WHERE(defined_os_arr.os_num EQ os.os_num) ho= WHERE(defined_os_arr(w(0)).ip(defined_os_arr(w(0)).iptable).steps EQ 5, ho_cnt) ; Find Header-Only images that are not part of a HI summing seqeunce and exclude them ; from no_ho_expanded so that they are not used for Secchi-Buffer and downlink channels: ;help,ho_cnt,os_dest ;stop IF (ho_cnt EQ 0 OR os_dest(dw(0)).summed EQ 1) THEN BEGIN IF (no_ho_expanded(0).os_num EQ 0) THEN $ no_ho_expanded= expand_os $ ; first time ELSE $ no_ho_expanded= [no_ho_expanded,expand_os] ENDIF ELSE BEGIN ;print,'excluded OS '+strtrim(os.os_num,2)+' Header-Only image (not a HI-summing) so it does not go to APIDs.' ENDELSE ENDFOR ; kk ENDFOR ; j ENDFOR ; i ;Re-draw left and right boundries of OS plots in white in case some parts ;are not white anymore: OPLOT,[t1,t1],[0,rows-1],PSYM=0,LINESTYLE=0 OPLOT,[t2,t2],[0,rows-1],PSYM=0,LINESTYLE=0 ; Also re-draw horizontal lines between Oses in white: FOR hline = yy1, yy2, height DO BEGIN OPLOT, [t1,t2], [hline,hline], PSYM=0, LINESTYLE=0 ENDFOR OPLOT, [t1,t2], [hline,hline], PSYM=0, LINESTYLE=0 ; line right below "SCIP DoorClosures". ; Add initialize timeline command if one exists: expanded= expanded(SORT(expanded.ccd_stop)) no_ho_expanded= no_ho_expanded(SORT(no_ho_expanded.ccd_stop)) ; ; Draw the lines for secchi-buffer ; CONT: CASE schedv.sc OF 0: BEGIN ; add run script line: FOR itc=1, N_ELEMENTS(rsc)-1 DO BEGIN ; first rsc is dummy. ; times are in TAI format, convert to hours since start STARTDIS day itime = (rsc(itc).dt - daystart) / 3600D OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=3 ;rslab= rsc(itc).sc+' '+STRMID(rsc(itc).fn,STRLEN(rsc(itc).fn)-12,12) rslab= rsc(itc).sc+' '+STRMID(rsc(itc).fn,RSTRPOS(rsc(itc).fn,'.')-8,20) IF (rsc(itc).bsf GT 0) THEN rslab= rslab+' (bsf)' XYOUTS,itime,70, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90, rslab ENDFOR ; add init command line: FOR itc=1, N_ELEMENTS(ic)-1 DO BEGIN ; first ic is dummy. ; times are in TAI format, convert to hours since start STARTDIS day itime = (ic(itc).dt - daystart) / 3600D OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=1 ;red (OSes Y-range only) plab= ic(itc).sc IF (ic(itc).bsf GT 0) THEN $ XYOUTS,itime,60, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90,ic(itc).sc+ '(bsf)' $ ELSE $ XYOUTS,itime,65, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ic(itc).sc ENDFOR END 1: BEGIN ; add run script line: icind= WHERE(rsc.sc EQ 'A', icnt) FOR itc=0, icnt-1 DO BEGIN ; first rsc is dummy. itime = (rsc(icind(itc)).dt - daystart) / 3600D OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=3 ;rslab= STRMID(rsc(icind(itc)).fn,STRLEN(rsc(icind(itc)).fn)-12,12) rslab= STRMID(rsc(icind(itc)).fn,RSTRPOS(rsc(icind(itc)).fn,'.')-8,20) IF (rsc(icind(itc)).bsf GT 0) THEN rslab= rslab+' (bsf)' XYOUTS,itime,70, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90,rslab ENDFOR ; add init command line: icind= WHERE(ic.sc EQ 'A', icnt) FOR itc=0, icnt-1 DO BEGIN ; first ic is dummy. itime = (ic(icind(itc)).dt - daystart) / 3600D OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=1 IF (ic(icind(itc)).bsf GT 0) THEN $ XYOUTS,itime,70, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90,'(bsf)' ENDFOR END 2: BEGIN ; add run script line: icind= WHERE(rsc.sc EQ 'B', icnt) FOR itc=0, icnt-1 DO BEGIN ; first rsc is dummy. itime = (rsc(icind(itc)).dt - daystart) / 3600D OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=3 ;rslab= STRMID(rsc(icind(itc)).fn,STRLEN(rsc(icind(itc)).fn)-12,12) rslab= STRMID(rsc(icind(itc)).fn,RSTRPOS(rsc(icind(itc)).fn,'.')-8,20) IF (rsc(icind(itc)).bsf GT 0) THEN rslab= rslab+' (bsf)' XYOUTS,itime,70, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90,rslab ENDFOR ; IF (b_rs_date NE 0.0D) THEN BEGIN ; ; times are in TAI format, convert to hours since start STARTDIS day ; itime = (b_rs_date - daystart) / 3600D ; OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=3 ; XYOUTS,itime,60, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90, $ ; STRMID(b_rsf,STRLEN(b_rsf)-12,12) ; ENDIF ; add init command line: icind= WHERE(ic.sc EQ 'B', icnt) FOR itc=0, icnt-1 DO BEGIN ; first ic is dummy. itime = (ic(icind(itc)).dt - daystart) / 3600D OPLOT, [itime,itime],[40.0,100.0], PSYM=0, LINESTYLE=0, COLOR=1 IF (ic(icind(itc)).bsf GT 0) THEN $ XYOUTS,itime,70, FONT=-1,ALIGN=0.5,CHARSIZE=charsize,ORIENTATION=90,'(bsf)' ENDFOR END ENDCASE ; The Space Weather Beacon is a low rate 400 bits/sec and 24/7 (real-time) downlink channel. ; It is buffered by the Spacecraft to a maximum of 48 hours of data so it can hold up to ; 69120000.0 bits at any given second. This info is read from a save file. ; The "Use Space Weather APID" function must have been selected for an image to be downlinked ; via the Space Weather Channel. ; ;RESTORE,'space_weather_buf.dat' ; AEE - 6/13/03 ;=> SW_RATE FLOAT = 400.0 (sec) ;=> SW_CAPACITY FLOAT = 48.0 (days) ;sw_bsize= (SW_RATE)*(SW_CAPACITY*3600.0) ;=> 69120000.0 bits ;RESTORE,'secchi_downlink_channels.sav' ; AEE 6/16/03 ; filename= GETENV('PT')+'/IN/OTHER/'+'secchi_downlink_channels.sav' ; RESTORE, filename ;=> CHANNELS. ;SB_CAPACITY FLOAT 32.0 ; Mega Bytes (Secchi-Buffer RAM disk) ;SB_RATE FLOAT 150000.0 ; bits/sec (it is really 153 kbs but used 150 kbs) ;SSR1_CAPACITY FLOAT 645.000 ; Mega Bytes ;SSR1_RATE FLOAT 42000.0 ; bits/sec ;SSR2_CAPACITY FLOAT 161.000 ; Mega Bytes ;SSR2_RATE FLOAT 42000.0 ; bits/sec ;RT_CAPACITY FLOAT 250.000 ; Mega Bytes (page 29) ;RT_RATE FLOAT 12000.0 ; bits/sec (page32 MissionOps. of GS CDR PR) ;SW_CAPACITY FLOAT 12.5000 ; Mega Bytes (page 29) ;SW_RATE FLOAT 500.000 ; bits/sec (page32 MissionOps. of GS CDR PR ;filename= GETENV('PT')+'/IN/OTHER/'+'secchi_ssr_info.sav' ;RESTORE, filename ;=> PLAYBACKS. ;SB_CAPACITY FLOAT 50.0000 ;SB_RATE FLOAT 150000. ; bps ;SSR1_CAPACITY FLOAT 655.300 ; max cap. ;SSR2_CAPACITY FLOAT 163.825 ; max cap. ;SW_CAPACITY FLOAT 12.5000 ; max cap. ;HIGH_VOLUME FLOAT 583.570 ; downloadable SSR cap. for months 0-14 ;MID_VOLUME FLOAT 538.625 ; downloadable SSR cap. for months 14-18 ;LOW_VOLUME FLOAT 490.157 ; downloadable SSR cap. for months 18-24 ;SSR1PCT FLOAT 92.3000 ; % of SSR cap. allocated to SSR1 ;SSR2PCT FLOAT 6.00000 ; % of SSR cap. allocated to SSR2 ;SWPCT FLOAT 1.80000 ; % of SSR cap. allocated to SW ;filename= GETENV('PT')+'/IN/OTHER/'+'secchi_ssr_info.sav' ;CASE schedv.drate OF ; 0: channels= READ_SSR_INFO(filename,'high') ; 1: channels= READ_SSR_INFO(filename,'med') ; 2: channels= READ_SSR_INFO(filename,'low') ;ENDCASE channels= READ_SSR_INFO() ;For 'high' date_rate, ssr_data: ;SB_CAPACITY FLOAT 50.0000 ;SB_RATE FLOAT 150000. ; bps ;SSR1_CAPACITY FLOAT 655.300 ; max SSR1 capacity ;SSR1_VOL FLOAT 538.635 ; max SSR1 data that can be played back in 24 hrs. ;SSR1_RATE FLOAT 598.483 ; bps SSR1 PB rate (to PB 24hr of data in 1st 2 hrs) ;SSR2_CAPACITY FLOAT 163.825 ; max SSR2 capacity ;SSR2_VOL FLOAT 35.0142 ; max SSR2 data that can be played back in 2 hrs ;SSR2_RATE FLOAT 38.9047 ; bps SSR2 PB rate (in 1st 2 hrs of PB) ;SSR2_RATE2 FLOAT 311.137 ; bps SSR2 PB rate (remaining .92 hrs of SSR2 PB, if possible) ;SW_CAPACITY FLOAT 12.5000 ; max SW capacity ;SW_VOL FLOAT 10.5043 ; max SW data played back in 24 hrs ;SW_RATE FLOAT 0.972617 ; bps SW PB rate (to PB 24hr of data in 24 hrs) charsize=1.0 ; ; Draw the lines for Tape Dump & Plot. ; mt= 39.9 mb= 37.5 OPLOT,[t1,t2],[mb,mb],PSYM=0,LINESTYLE=0 OPLOT,[t1,t2],[mt,mt],PSYM=0,LINESTYLE=0 XYOUTS,t1,mt-1.0-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'DSN ',color= 4 ; yellow XYOUTS,t1,mt-1.0-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,' PlayBack ',color= 2 id = WHERE(kap_resource_names EQ "DSN_CONTACT") & id = id(0) ind = -1 IF (DATATYPE(kap_resource_arr) EQ 'STC') THEN $ ind = WHERE(kap_resource_arr.id EQ id) col_ind = [255, 170] IF (ind(0) GE 0) THEN BEGIN dsn_contact = kap_resource_arr(ind) ind = SORT([dsn_contact.startime]) ;** sort by start time dsn_contact = dsn_contact(ind) FOR i = 0,N_ELEMENTS(dsn_contact)-1 DO BEGIN x1 = (dsn_contact(i).startime - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x2 = (dsn_contact(i).endtime - daystart) / 3600D ;** tai -> hrs since start STARTDIS day x1 = x1 > !X.CRANGE(0) x2 = x2 < !X.CRANGE(1) y1 = mb y2 = mt IF (x2 GE x1) THEN BEGIN ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) POLYFILL, [x1,x2,x2,x1], [y1,y1,y2-0.32,y2-0.32], COLOR= 4 ;yellow ENDIF ENDFOR ENDIF id = WHERE(kap_resource_names EQ "TLM_TAPE_DUMP") & id = id(0) ind = -1 IF (DATATYPE(kap_resource_arr) EQ 'STC') THEN $ ind = WHERE(kap_resource_arr.id EQ id) IF (ind(0) GE 0) THEN BEGIN tape_dump = kap_resource_arr(ind) IF (schedv.fakepb) THEN BEGIN ; fakepb = 1 ; use a tape_dump of 24 hrs long if fake playback is requested (for calibration ; and ground testing): tape_dump= tape_dump(0) tape_dump(0).startime= schedv.startdis tape_dump(0).endtime= schedv.startdis + 86400.0D ; Note: SSR1 and SSR2 rate in channels are for 2hr SSR1 play back and 2.92 SSR2 play back. ; Change them for continious 24 hr play back: channels.ssr1_rate= channels.ssr1_vol*8000000/86400.0 ; change from 2 hrs to 24 hrs rate (bps) ;channels.ssr2_rate1= channels.ssr2_vol*8000000/86400.0 ;channels.ssr2_rate= channels.ssr2_capacity*8000000/86400.0 ; for SSR2, use full capacity for ;channels.ssr2_rate2= channels.ssr2_rate ; 24 hr playback (same rate always) ENDIF ind = SORT([tape_dump.startime]) ;** sort by start time tape_dump = tape_dump(ind) ;xdump= {xdump,x1:0.0,x2:0.0} ;xdump= {dumps,x1:0.0,x2:0.0,rate:FLTARR(2)} ;xdump= {dumps,x1:0.0,x2:0.0,rate:FLTARR(3)} xdump= {dumps,x1:0.0,x2:0.0,rate:FLTARR(4)} ; added rt_rate to rate full_dumps= xdump ; AEE 3/16/04 - added FOR i = 0,N_ELEMENTS(tape_dump)-1 DO BEGIN x1 = (tape_dump(i).startime - daystart) / 3600D ;** tai -> hrs since start STARTDIS day ; 01/11/05: ; If playback start before start of display and extends beyond the start of display, then ; set the playback start time to start of display: ; IF (tape_dump(i).startime LT schedv.startdis AND $ ; tape_dump(i).endtime GT schedv.startdis) THEN x1 = 0D x2 = (tape_dump(i).endtime - daystart) / 3600D ;** tai -> hrs since start STARTDIS day ; AEE 3/16/04 - keep all of tapedumps (playbacks) including those that are prior to the start ; of the plot-display (going back prev_hr) since at the end of each playback the SSR ; (SSR1 and SSR2) write-limit pointer is set to the position of read-pointer (any remaining ; data that is not downloaded, if any, is saved). We need the previous SSR playbacks to ; know how much data, if any, should be shown at the start of the SSR1 and SSR2 plot displays. ; x1 and x2 are in units of days so they should be multipied by 24*3600=86400 to change to ; seconds. First element of full_dumps (0,0) is extra and should be ignored. ;IF (x1 GE 0 AND x1 LT !X.CRANGE(1)) THEN BEGIN IF (x1 GE -prev_hr AND x1 LT !X.CRANGE(1)) THEN BEGIN ;only go back prev_hr before the start of plot-dispay and keep only to the end of plot-display. ; use the actual x1 and x2 of playback to show correct accumulation of SSR data ; in terms of seconds since start day (not start of the plot-display): xdump.x1= (x1 - (!X.CRANGE(0)-prev_hr))*3600D x2= x2 < !X.CRANGE(1) ; keep only to the end of plot-display. xdump.x2= (x2 - (!X.CRANGE(0)-prev_hr))*3600D ; 05/25/05 - Note: ; Rates in channels structure are bits/sec for a 24hr (86400 sec) playback. Adjust the ; rates for SSR1 and SSR2 since for these two, playback is is usually 4 hrs per day but ; since the same amount of data for 24 hr will be transferred, the rate per second for ; the 4 hrs increases. Also allow maximum of 24 hr playback: ; dump_secs= (tape_dump(i).endtime - tape_dump(i).startime) < 86400.0D ; not longer than a day ; xdump.rate(0)= (channels.ssr1_rate*86400.0)/dump_secs ; xdump.rate(1)= (channels.ssr2_rate*86400.0)/dump_secs ; full_dumps= [full_dumps,xdump] xdump.rate(0)= channels.ssr1_rate xdump.rate(1)= channels.ssr2_rate ; for first 2 hrs of SSR2 playback xdump.rate(2)= channels.ssr2_rate2 ; For remaining (.92 hrs) of SSR2 playback ; add rt_rates (they are not sorted by time): rtind= WHERE(rt_rates.startime EQ tape_dump(i).startime AND $ rt_rates.endtime EQ tape_dump(i).endtime, rtcnt) IF (rtcnt GT 0) THEN $ xdump.rate(3)= rt_rates(rtind(0)).rt_rate $ ELSE $ xdump.rate(3)= 3.6 ; default kbps xdump.rate(3)= xdump.rate(3) * 1000 ;bps full_dumps= [full_dumps,xdump] ENDIF x1 = x1 > !X.CRANGE(0) x2 = x2 < !X.CRANGE(1) y1 = mb y2 = mt- 1.0 IF (x2 GE x1) THEN BEGIN ; throws out dumps that are completely before the display start-time. xdump.x1= (x1 - (!X.CRANGE(0)-prev_hr))*3600D ;x1 and x2 in terms of seconds since start xdump.x2= (x2 - (!X.CRANGE(0)-prev_hr))*3600D IF (DATATYPE(x_tdump) EQ 'UND') THEN $ x_tdump= xdump $ ELSE $ x_tdump= [x_tdump,xdump] ;** make sure line is at least 1 pixel wide x2 = x2 > (convert_coord([(convert_coord([x1,0], /TO_DEVICE))(0)+1,0], /TO_DATA, /DEVICE))(0) POLYFILL, [x1,x2,x2,x1], [y1,y1,y2,y2], COLOR= 2 ENDIF ENDFOR ENDIF ELSE goto, wrap_up ; NOTE: now x_tdump contains all playbacks within displayed area and full_dumps contains all ; playbacks from prev_hr (24 hrs) before start of display area, if any, to the end of display area. IF (schedv.sc EQ 1) THEN BEGIN sbuf_pct_start= schedv.sbuf_pct_start_a ssr1_pct_start= schedv.ssr1_pct_start_a ssr2_pct_start= schedv.ssr2_pct_start_a ssr2_pct_pb= schedv.ssr2_pct_pb_a rt_pct_start= schedv.rt_pct_start_a sw_pct_start= schedv.sw_pct_start_a ENDIF IF (schedv.sc EQ 2) THEN BEGIN sbuf_pct_start= schedv.sbuf_pct_start_b ssr1_pct_start= schedv.ssr1_pct_start_b ssr2_pct_start= schedv.ssr2_pct_start_b ssr2_pct_pb= schedv.ssr2_pct_pb_b rt_pct_start= schedv.rt_pct_start_b sw_pct_start= schedv.sw_pct_start_b ENDIF sb_ylimit= 37.4 ; AEE - 6/17/03 - SECCHI Buffer sb_ytop = 37.0 sb_ybot = 30.0 sb_y20= sb_ybot + (sb_ytop-sb_ybot)/100.0 * 20 sb_y30= sb_ybot + (sb_ytop-sb_ybot)/100.0 * 30 sb_y50= sb_ybot + (sb_ytop-sb_ybot)/100.0 * 50 sb_y70= sb_ybot + (sb_ytop-sb_ybot)/100.0 * 70 sb_y80= sb_ybot + (sb_ytop-sb_ybot)/100.0 * 80 OPLOT,[t1,t2],[sb_ylimit,sb_ylimit],PSYM=0,LINESTYLE=0 XYOUTS,t1,sb_y70-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'Secchi-Buffer ' sbz= '('+STRTRIM(STRING(channels.sb_capacity,'(f5.1)'),2)+' MB) ' ;buf size in MB. XYOUTS,t1,sb_y30-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,sbz sbinfo='' IF (schedv.sc NE 0) THEN $ sbinfo= 'Start% = '+STRTRIM(STRING(sbuf_pct_start,'(f5.1)'),2) XYOUTS,t1,sb_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,sbinfo,COLOR=7 ; AEE 4/7/04 added rates: sbrate= STRTRIM(STRING(channels.sb_rate/1000,'(i5)'),2) XYOUTS,0.994,0.190, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,sbrate XYOUTS,0.996,0.180,FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,'kbps' t3= 48.0 ; AEE 7/11/03 - use to make the dots of dotted lines the same for all plot ranges. OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(sb_ytop,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,sb_ytop-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'100' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(sb_y80,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,sb_y80-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'80' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(sb_y20,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,sb_y20-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'20' XYOUTS,t1,sb_ybot-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'0' s1_ylimit= 29.9 ; AEE - 6/17/03 - SSR1 Channel s1_ytop = 29.5 s1_ybot = 22.5 s1_y20= s1_ybot + (s1_ytop-s1_ybot)/100.0 * 20 s1_y30= s1_ybot + (s1_ytop-s1_ybot)/100.0 * 30 s1_y50= s1_ybot + (s1_ytop-s1_ybot)/100.0 * 50 s1_y70= s1_ybot + (s1_ytop-s1_ybot)/100.0 * 70 s1_y80= s1_ybot + (s1_ytop-s1_ybot)/100.0 * 80 OPLOT,[t1,t2],[s1_ylimit,s1_ylimit],PSYM=0,LINESTYLE=0 XYOUTS,t1,s1_y70-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'SSR1-Channel ' ;sbz= '('+STRTRIM(STRING(channels.ssr1_capacity,'(f5.1)'),2)+' MB) ' ;buf size in MB. ;XYOUTS,t1,s1_y30-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz sbz= '('+STRTRIM(STRING(channels.ssr1_capacity,'(f5.1)'),2)+'/' sbz1= STRTRIM(STRING(channels.ssr1_vol,'(f5.1)'),2) XYOUTS,t1,s1_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz+' ' XYOUTS,t1,s1_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz1+' ',color=5 ; brown XYOUTS,t1,s1_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,' MB) ' ; draw brown (5) line at daily volume capacity: OPLOT,[t1,t2],REPLICATE(s1_ybot+(s1_ytop-s1_ybot)*(channels.ssr1_vol/channels.ssr1_capacity),2),color=5 s1info= '' IF (schedv.sc NE 0) THEN $ s1info= 'Start% = '+STRTRIM(STRING(ssr1_pct_start,'(f5.1)'),2) XYOUTS,t1,s1_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,s1info,COLOR=7 ; AEE 4/7/04 added rates: ssr1rate= STRTRIM(STRING(channels.ssr1_rate/1000,'(i5)'),2) XYOUTS,0.994,0.158, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,ssr1rate,color=5 ; brown XYOUTS,0.996,0.148, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,'kbps' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(s1_ytop,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,s1_ytop-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'100' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(s1_y80,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,s1_y80-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'80' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(s1_y20,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,s1_y20-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'20' XYOUTS,t1,s1_ybot-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'0' s2_ylimit= 22.4 ; AEE - 6/17/03 - SSR2 Channel s2_ytop = 22.0 s2_ybot = 15.0 s2_y20= s2_ybot + (s2_ytop-s2_ybot)/100.0 * 20 s2_y30= s2_ybot + (s2_ytop-s2_ybot)/100.0 * 30 s2_y50= s2_ybot + (s2_ytop-s2_ybot)/100.0 * 50 s2_y70= s2_ybot + (s2_ytop-s2_ybot)/100.0 * 70 s2_y80= s2_ybot + (s2_ytop-s2_ybot)/100.0 * 80 OPLOT,[t1,t2],[s2_ylimit,s2_ylimit],PSYM=0,LINESTYLE=0 XYOUTS,t1,s2_y70-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'SSR2-Channel ' ;sbz= '('+STRTRIM(STRING(channels.ssr2_capacity,'(f5.1)'),2)+' MB) ' ;buf size in MB. ;XYOUTS,t1,s2_y30-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz sbz= '('+STRTRIM(STRING(channels.ssr2_capacity,'(f5.1)'),2)+'/' sbz1= STRTRIM(STRING(channels.ssr2_vol,'(f5.1)'),2) XYOUTS,t1,s2_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz+' ' XYOUTS,t1,s2_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz1+' ',color=5 ; brown XYOUTS,t1,s2_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,' MB) ' ; draw brown (5) line at daily volume capacity: OPLOT,[t1,t2],REPLICATE(s2_ybot+(s2_ytop-s2_ybot)*(channels.ssr2_vol/channels.ssr2_capacity),2),color=5 s2info= '' IF (schedv.sc NE 0) THEN $ ; s2info= 'Start% = '+STRTRIM(STRING(ssr2_pct_start,'(f5.1)'),2)+ $ ; ' & PB%= '+STRTRIM(STRING(ssr2_pct_pb,'(f5.1)'),2) s2info= 'Start% = '+STRTRIM(STRING(ssr2_pct_start,'(f5.1)'),2) XYOUTS,t1,s2_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,s2info,COLOR=7 ; AEE 4/7/04 added rates: ;ssr2rate= STRTRIM(STRING(channels.ssr2_rate/1000,'(i5)'),2) ssr2rate= STRTRIM(STRING(channels.ssr2_rate/1000.0,'(f5.1)'),2) XYOUTS,0.996,0.123, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,ssr2rate, color=5 ; brown ;XYOUTS,0.996,0.113, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,'kbps' ;ssr2rate2= STRTRIM(STRING(channels.ssr2_rate2/1000.0,'(f5.1)'),2) IF(channels.ssr2_rate2/1000.0 GE 100) THEN $ ssr2rate2= STRTRIM(STRING(channels.ssr2_rate2/1000.0,'(i5)'),2) $ ELSE $ ssr2rate2= STRTRIM(STRING(channels.ssr2_rate2/1000.0,'(f5.1)'),2) XYOUTS,0.996,0.113, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,ssr2rate2, color=5 ; brown XYOUTS,0.996,0.104, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,'kbps' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(s2_ytop,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,s2_ytop-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'100' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(s2_y80,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,s2_y80-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'80' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(s2_y20,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,s2_y20-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'20' XYOUTS,t1,s2_ybot-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'0' rt_ylimit= 14.9 ; AEE - 6/17/03 - Real Time Channel rt_ytop = 14.5 rt_ybot = 7.5 rt_y20= rt_ybot + (rt_ytop-rt_ybot)/100.0 * 20 rt_y30= rt_ybot + (rt_ytop-rt_ybot)/100.0 * 30 rt_y50= rt_ybot + (rt_ytop-rt_ybot)/100.0 * 50 rt_y70= rt_ybot + (rt_ytop-rt_ybot)/100.0 * 70 rt_y80= rt_ybot + (rt_ytop-rt_ybot)/100.0 * 80 OPLOT,[t1,t2],[rt_ylimit,rt_ylimit],PSYM=0,LINESTYLE=0 XYOUTS,t1,rt_y70-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'RT-Channel ' ; AEE 6/17/03 ; Note: rt_channel.sav is not used anymore. RT rates now are read from SCA file ; and are in full_dumps.rate(3,*) ; ; ; AEE 4/7/04: RT-channel can only hold 1 packet (272 bytes or ~0.3KB) at a time: ; ; RESTORE,GETENV('PT')+'/IN/OTHER/'+'rt_channel.sav' ; ; => ; ; rt_rate= 50 Note: this value, (packets/sec), can change daily and should be read in ; ; from a file. ; ; This is also true for schedule_convert_units.pro and other routines ; ; that may use secchi_downlink_channels.sav file. ; ; rt_capacity= 1 1 packet ;sbz= '('+STRTRIM(rt_capacity,2)+'pkt=272B*'+STRTRIM(rt_rate,2)+') ' ;sbz= '('+STRTRIM(rt_capacity,2)+'pkt=272B)*'+STRTRIM(rt_rate,2)+' ' sbz= '(1 pkt=272B) ' ;XYOUTS,0.166,0.086, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,sbz XYOUTS,0.1,0.078, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,/normal,sbz rtinfo= '' IF (schedv.sc NE 0) THEN $ rtinfo= 'Start% = '+STRTRIM(STRING(rt_pct_start,'(f5.1)'),2) ;XYOUTS,t1,rt_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,rtinfo,COLOR=7 ; AEE 4/7/04 added rates: ;rtrate= rt_rate*272*8.0/1000.0 ; kbs IF (DATATYPE(x_tdump) EQ 'STC') THEN $ rtrate= x_tdump(0).rate(3) $ ; use 1st available rt_rate (bps) within display window ELSE $ rtrate= 3.6*1000.0 ; default (bps) rtstr= STRTRIM(STRING(rtrate/1000.0,'(f5.1)'),2) XYOUTS,0.994,0.088, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,rtstr XYOUTS,0.996,0.078, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,'kbps' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(rt_ytop,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,rt_ytop-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'100' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(rt_y80,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,rt_y80-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'80' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(rt_y20,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,rt_y20-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'20' XYOUTS,t1,rt_ybot-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'0' ;help,full_dumps, x_tdump,xdump ;stop sw_ylimit= 7.4 ; AEE - 6/17/03 - Space Weather Channel sw_ytop = 7.0 sw_ybot = 0.0 sw_y20= sw_ybot + (sw_ytop-sw_ybot)/100.0 * 20 sw_y30= sw_ybot + (sw_ytop-sw_ybot)/100.0 * 30 sw_y50= sw_ybot + (sw_ytop-sw_ybot)/100.0 * 50 sw_y70= sw_ybot + (sw_ytop-sw_ybot)/100.0 * 70 sw_y80= sw_ybot + (sw_ytop-sw_ybot)/100.0 * 80 OPLOT,[t1,t2],[sw_ylimit,sw_ylimit],PSYM=0,LINESTYLE=0 XYOUTS,t1,sw_y70-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'SW-Channel ' ; AEE 6/17/03 ;sbz= '('+STRTRIM(STRING(channels.sw_capacity,'(f5.1)'),2)+' MB) ' ;buf size in MB. ;XYOUTS,t1,sw_y30-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz sbz= '('+STRTRIM(STRING(channels.sw_capacity,'(f5.1)'),2)+'/' sbz1= STRTRIM(STRING(channels.sw_vol,'(f5.1)'),2) XYOUTS,t1,sw_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz+' ' XYOUTS,t1,sw_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,sbz1+' ',color=5 ; brown XYOUTS,t1,sw_y30, FONT=-1,ALIGN=1,CHARSIZE=charsize+0.1,' MB) ' ; draw brown (5) line at daily volume capacity: OPLOT,[t1,t2],REPLICATE(sw_ybot+(sw_ytop-sw_ybot)*(channels.sw_vol/channels.sw_capacity),2),color=5 swinfo= '' IF (schedv.sc NE 0) THEN $ swinfo= 'Start% = '+STRTRIM(STRING(sw_pct_start,'(f5.1)'),2) XYOUTS,t1,sw_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,swinfo,COLOR=7 ; AEE 4/7/04 added rates: IF (FIX(channels.sw_rate/1000) EQ 0) THEN $ swrate= STRTRIM(STRING(channels.sw_rate/1000.0,'(f5.1)'),2) $ ELSE $ swrate= STRTRIM(STRING(channels.sw_rate/1000,'(i5)'),2) XYOUTS,0.992,0.056, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,swrate,color=5 ; brown XYOUTS,0.996,0.046, FONT=-1,ALIGN=1,CHARSIZE=charsize,/normal,'kbps' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(sw_ytop,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,sw_ytop-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'100' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(sw_y80,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,sw_y80-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'80' OPLOT,FINDGEN(t3)*(t2/t3),REPLICATE(sw_y20,t3),PSYM=3,LINESTYLE=1 ; use a dotted line XYOUTS,t1,sw_y20-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'20' XYOUTS,t1,sw_ybot-dy, FONT=-1,ALIGN=1,CHARSIZE=charsize,'0' IF schedv.sc EQ 0 THEN sclab= 'SECCHI/STEREO SC: A & B ' IF schedv.sc EQ 1 THEN sclab= 'SECCHI/STEREO SC: A ' IF schedv.sc EQ 2 THEN sclab= 'SECCHI/STEREO SC: B ' ;XYOUTS,t1,-7.0, FONT=-1, ALIGN=0.5, CHARSIZE=charsize*1.3, sclab, COLOR= 10 XYOUTS,t1,-7.0, FONT=-1, ALIGN=0.5, CHARSIZE=charsize*1.3, sclab, COLOR= 4 ; yellow ;See if user wants the statistics/buffers/etc. updated or not. Skipping the rest of ;this code speeds up things a lot when wanting to move the schedule back and forth ; many times. It should be set to 'Update' (0) when the schedule is satisfactory and ; the final schedule is to saved: RESET_STATS, schedv, startdis, enddis ;IF (schedv.up_stats) THEN BEGIN ; AEE 7/30/03 ; RESET_STATS, schedv, startdis, enddis ; RETURN ;END ;IF (schedv.up_stats) THEN RETURN IF (schedv.up_stats) THEN GOTO, WRAP_UP IF (schedv.sc EQ 0) THEN BEGIN ; AEE 7/30/03 ; Disable generate IPT and plans for commanding and return: ;WIDGET_CONTROL,schedv.gipt, SENSITIVE=0 ; WIDGET_CONTROL,schedv.csf, SENSITIVE=0 WIDGET_CONTROL,schedv.gall, SENSITIVE=0 ; WIDGET_CONTROL,schedv.conf, SENSITIVE=0 ;RETURN GOTO, WRAP_UP ENDIF ELSE BEGIN ; Able generate IPT and plans for commanding. ;WIDGET_CONTROL,schedv.gipt, SENSITIVE=1 ;WIDGET_CONTROL,schedv.csf, SENSITIVE=1 WIDGET_CONTROL,schedv.gall, SENSITIVE=1 ;WIDGET_CONTROL,schedv.conf, SENSITIVE=1 ENDELSE ; ; Plot the secchi-buffer and downlink channels: ; ; for each OS in the defined_os_arr, an array of 5 values are returned one for each APID. ; The values (for downlink channel) correspond to: [SSR1, SSR2, RT, SW, GT] ; Each value can have a range of 0 to 4 except for the first (SSR1) that can have a range ; of 0-23 (6 to 23 is used to preserve the original value fo SSR1): ; 0 = No image is dowlinked on this channel. ; 1 = 1st APID (can be the only one) specified by IP functions as the downlink channel ; 2 = 2nd APID specified by IP functions as the downlink channel. ; 3 = 3rd APID specified by IP functions as the downlink channel. ; 4 = 4th APID specified by IP functions as the downlink channel. ; 5 = 5th APID specified by IP functions as the downlink channel. ; Following only applies to SSR1: ; 6-11 = RT image is also added to SSR1 by default. ; 6 = No explicit SSR1 image from PT ; 7 = explicit SSR1 image from PT appeared 1st ; 8 = explicit SSR1 image from PT appeared 2nd ; 9 = explicit SSR1 image from PT appeared 3rd ; 10 = explicit SSR1 image from PT appeared 4th ; 11 = explicit SSR1 image from PT appeared 5th ; 12-17 = SW image is also added to SSR1 by default. ; 18-23 = RT and SW images are also added to SSR1 by default. usage = LONARR(5) ;** telemetry usage by each telescope ;AEE arrx = (FINDGEN(secs) + (!X.CRANGE(0)-prev_hr)*3600D) / 3600D ; AEE - Dec 16, 02 arry = FLTARR(5,secs) ;** only contains os_size at os_stop for every scheduled image IF (DATATYPE(os_arr) NE 'INT') THEN BEGIN IF (DATATYPE(os_dest) NE 'UND') THEN BEGIN sc= 'A' ; assume spacecraft-A for now IF (schedv.sc EQ 2) THEN sc= 'B' ;help,os_dest,expanded,no_ho_expanded ;stop EXPAND_OSES, expanded, os_dest, sc ; AEE 7/21/03 expand the expanded for selected APIDs and ; only keep the last image of a HI sequence that is summed. ;help,expanded,no_ho_expanded ;stop IF (no_ho_expanded(0).os_num NE 0) THEN $ EXPAND_OSES, no_ho_expanded, os_dest, sc ;help,os_dest,expanded,no_ho_expanded ;stop ; Note: expanded is used later for generating output files (.IPT, commands, etc). ; no_ho_expanded is used here to populate secchi-buffer and downlink channels. ; ; ***** need verification for: ****** ; Also, since no_ho_expanded does not include the Header-Only images that are not ; HI Sequence (LP=6) with summing related, the img_cnt for its images are going ; to be different than img_cnt in expanded that contains other Header-Only images. ; The Header-Only images that are not HI summed-seq must be counted as images ; by using the expanded (not no_ho_expanded) for creating output files. ; Note: The engineering (HK) files also go through the 32MB ram-disk and have priority ; over the other images. But, They are very small in size and are negliable. So, ; I don't have to account for the engineering data when displaying the times ; when images are placed in the ram-disk (if not must readin the times and sizes ; of the eng. data from an input file and use them in PT). If in a day, a lot of ; eng data is to be collected, we can set the SSR1 start buffer % full to some ; percentage to account for it (The eng (HK) data are downlinked through SSR1). ; Note: a full size secchi image take ~2 minutes to be transferred over the RAM disk. ; PLOT Secchi-Buffer (RAM disk) for all images regardless of destination: ;REMOVE_SAVED_IMAGES, no_ho_expanded , defined_os_arr ;AEE 3/2/04: ; Note: the Secchi-Buffer (RAM disk) telemtry rate is 153kbs (not 42 kbs). ; Note: The "Header-Only" images (either intermediate HI summing sequence images or ; other images that are "Header-Only") DO NOT go to the Secchi-Buffer (Ram Disk). ; So, use the no_hdr_expanded for all channels including Secchi-Buffer: WIDGET_CONTROL,mdiag,SET_VALUE='Managing and rendering Secchi-Buffer.......' ;pct_total = 0.0D ;pct_each = DBLARR(5) ;WIDGET_CONTROL, schedv.sb_tot, SET_VALUE= STRING(pct_total,'(f12.1)') +' ' ;WIDGET_CONTROL, schedv.sb_eu, SET_VALUE= STRING(pct_each(0),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.sb_c1, SET_VALUE= STRING(pct_each(1),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.sb_c2, SET_VALUE= STRING(pct_each(2),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.sb_h1, SET_VALUE= STRING(pct_each(3),'(f12.1)')+' ' ;WIDGET_CONTROL, schedv.sb_h2, SET_VALUE= STRING(pct_each(4),'(f11.1)')+' ' sb_usage=FLTARR(5,2) IF (DATATYPE(no_ho_expanded) EQ 'STC') THEN BEGIN PLOT_SECCHI_BUFFER, schedv, no_ho_expanded, prev_hr, channels.sb_rate, channels.sb_capacity, $ sb_ybot, sb_ytop, sb_ylimit, arrx, secs, startdis, enddis, sbuf_pct_start ENDIF XYOUTS,t1,sb_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,sbinfo,COLOR=7 ; Now manage the SSR1, SSR2, RT, and SW buffers but first modify the stop times of the ; expanded records to reflect the time it takes for each image to come out of the ; telemetry buffer (~2Min for a full size image). The new time is then the time that ; the image is placed in one or more of the SSR1, SSR2, RT, and/or SW partitions/buffers: ; print,'stop times going into telem. buffer:' ; print,expanded.stop ; ; expanded.stop= expanded.stop + (expanded.size/channels.sb_rate)/3600.0 ; .stop is in hours ; ; print,'stop times coming out of telem. buffer:' ; print,expanded.stop ; ; *** Note: use the sb_rate to gradually add the image to the SSR1, SSR2, SW, and RT instead of above. ; Manage SSR1 Partiton: WIDGET_CONTROL,mdiag,SET_VALUE='Managing and rendering SSR1-Channel.......' ;pct_total = 0.0D ;pct_each = DBLARR(7) ;WIDGET_CONTROL, schedv.s1_tot, SET_VALUE= STRING(pct_total,'(f12.1)') +' ' ;WIDGET_CONTROL, schedv.s1_eu, SET_VALUE= STRING(pct_each(0),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.s1_c1, SET_VALUE= STRING(pct_each(1),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.s1_c2, SET_VALUE= STRING(pct_each(2),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.s1_h1, SET_VALUE= STRING(pct_each(3),'(f12.1)')+' ' ;WIDGET_CONTROL, schedv.s1_h2, SET_VALUE= STRING(pct_each(4),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.s1_hk, SET_VALUE= STRING(pct_each(5),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.s1_gt, SET_VALUE= STRING(pct_each(6),'(f11.1)')+' ' s1_usage=FLTARR(7,2) noho_data= 0 IF (DATATYPE(no_ho_expanded) EQ 'STC') THEN BEGIN s1_ch= WHERE(STRPOS(no_ho_expanded.apid,'SSR1') GE 0 OR $ STRPOS(no_ho_expanded.apid,'S1RT') GE 0, s1_cnt) ; AEE 3/3/04 ;IF (s1_cnt GT 0) THEN BEGIN IF (s1_cnt GT 0) THEN noho_data= no_ho_expanded(s1_ch) ENDIF ;PLOT_SSR1_CHANNEL, schedv, no_ho_expanded(s1_ch), prev_hr,channels.ssr1_rate, $ ; PLOT_SSR1_CHANNEL, schedv, no_ho_expanded(s1_ch), prev_hr, full_dumps.rate(0,*), $ ; channels.ssr1_capacity,$ ; x_tdump, s1_ybot, s1_ytop, s1_ylimit, arrx, secs, startdis, $ ; enddis, ssr1_pct_start, channels.sb_rate, full_dumps ;PLOT_SSR1_CHANNEL, schedv, no_ho_expanded(s1_ch), prev_hr, full_dumps.rate(0,*), $ PLOT_SSR1_CHANNEL, schedv, noho_data, prev_hr, full_dumps.rate(0,*), $ channels.ssr1_capacity, channels.ssr1_vol, $ x_tdump, s1_ybot, s1_ytop, s1_ylimit, arrx, secs, startdis, $ enddis, ssr1_pct_start, channels.sb_rate, full_dumps, gt_data XYOUTS,t1,s1_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,s1info,COLOR=7 ;ENDIF ; Manage SSR2 partition: WIDGET_CONTROL,mdiag,SET_VALUE='Managing and rendering SSR2-Channel.......' ;pct_total = 0.0D ;pct_each = DBLARR(5) ;WIDGET_CONTROL, schedv.s2_tot, SET_VALUE= STRING(pct_total,'(f12.1)') +' ' ;WIDGET_CONTROL, schedv.s2_eu, SET_VALUE= STRING(pct_each(0),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.s2_c1, SET_VALUE= STRING(pct_each(1),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.s2_c2, SET_VALUE= STRING(pct_each(2),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.s2_h1, SET_VALUE= STRING(pct_each(3),'(f12.1)')+' ' ;WIDGET_CONTROL, schedv.s2_h2, SET_VALUE= STRING(pct_each(4),'(f11.1)')+' ' s2_usage= FLTARR(5,2) IF (DATATYPE(no_ho_expanded) EQ 'STC') THEN BEGIN s2_ch= WHERE(STRPOS(no_ho_expanded.apid,'SSR2') GE 0,s2_cnt) ; AEE 7/21/03 IF (s2_cnt GT 0) THEN BEGIN PLOT_SSR2_CHANNEL,schedv, no_ho_expanded(s2_ch), prev_hr, full_dumps.rate(1,*), $ full_dumps.rate(2,*), channels.ssr2_capacity, channels.ssr2_vol, $ x_tdump, s2_ybot, s2_ytop, s2_ylimit, arrx, secs, startdis, $ enddis, ssr2_pct_start, channels.sb_rate, full_dumps, ssr2_pct_pb XYOUTS,t1,s2_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,s2info,COLOR=7 ENDIF ENDIF ; Manage RT buffer: ; July 22, 03 ;**** note: RT buffer can only hold 1 packet (not 0.5MB). Dennis and Ladd are working on an ; algorithm as how to put and downlink an image which is more than one packet on ; the RT channel. Once the code is figured-out, I should also use it here to handle ; the RT files. ***** WIDGET_CONTROL,mdiag,SET_VALUE='Managing and rendering RT-Channel.......' ;pct_total = 0.0D ;pct_each = DBLARR(7) ;WIDGET_CONTROL, schedv.rt_tot, SET_VALUE= STRING(pct_total,'(f12.1)') +' ' ;WIDGET_CONTROL, schedv.rt_eu, SET_VALUE= STRING(pct_each(0),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.rt_c1, SET_VALUE= STRING(pct_each(1),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.rt_c2, SET_VALUE= STRING(pct_each(2),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.rt_h1, SET_VALUE= STRING(pct_each(3),'(f12.1)')+' ' ;WIDGET_CONTROL, schedv.rt_h2, SET_VALUE= STRING(pct_each(4),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.rt_hk, SET_VALUE= STRING(pct_each(5),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.rt_gt, SET_VALUE= STRING(pct_each(6),'(f11.1)')+' ' rt_usage=FLTARR(7,2) noho_data= 0 IF (DATATYPE(no_ho_expanded) EQ 'STC') THEN BEGIN rt_ch= WHERE(STRPOS(no_ho_expanded.apid,'RT') GE 0, rt_cnt) ; AEE 7/21/03 ;IF (rt_cnt GT 0) THEN BEGIN IF (rt_cnt GT 0) THEN noho_data= no_ho_expanded(rt_ch) ENDIF ; AEE 4/8/04: ; rt_rate and rt_capacity are initialized earlier in this routine to 50 and 1 for now. ; But these (espcially rt_rate) should be read in from a file since it may change everyday. ; Don't use channels save set for RT info. rt_capacity= 272*8 ; 1 packet in bits (this is not used in plot_rt_channel). ;PLOT_RT_CHANNEL,schedv, no_ho_expanded(rt_ch), prev_hr, rt_rate, rt_capacity, x_tdump, $ ;PLOT_RT_CHANNEL,schedv, no_ho_expanded(rt_ch), prev_hr, full_dumps.rate(3,*), rt_capacity, $ PLOT_RT_CHANNEL,schedv, noho_data, prev_hr, full_dumps.rate(3,*), rt_capacity, $ x_tdump, rt_ybot, rt_ytop, rt_ylimit, arrx, secs, startdis, enddis, gt_data ;XYOUTS,t1,rt_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,rtinfo,COLOR=7 ;ENDIF ; Manage SW buffer: WIDGET_CONTROL,mdiag,SET_VALUE='Managing and rendering SW-Channel.......' ;pct_total = 0.0D ;pct_each = DBLARR(5) ;WIDGET_CONTROL, schedv.sw_tot, SET_VALUE= STRING(pct_total,'(f12.1)') +' ' ;WIDGET_CONTROL, schedv.sw_eu, SET_VALUE= STRING(pct_each(0),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.sw_c1, SET_VALUE= STRING(pct_each(1),'(f13.1)')+' ' ;WIDGET_CONTROL, schedv.sw_c2, SET_VALUE= STRING(pct_each(2),'(f11.1)')+' ' ;WIDGET_CONTROL, schedv.sw_h1, SET_VALUE= STRING(pct_each(3),'(f12.1)')+' ' ;WIDGET_CONTROL, schedv.sw_h2, SET_VALUE= STRING(pct_each(4),'(f11.1)')+' ' sw_usage=FLTARR(5,2) IF (DATATYPE(no_ho_expanded) EQ 'STC') THEN BEGIN sw_ch= WHERE(STRPOS(no_ho_expanded.apid,'SW') GE 0, sw_cnt) ; AEE 7/21/03 IF (sw_cnt GT 0) THEN BEGIN PLOT_SW_CHANNEL, schedv, no_ho_expanded(sw_ch), prev_hr, channels.sw_rate, $ ;channels.sw_capacity, sw_ybot, sw_ytop, sw_ylimit, arrx, secs, $ channels.sw_capacity, channels.sw_vol, sw_ybot, sw_ytop, sw_ylimit, arrx, secs, $ startdis, enddis, sw_pct_start, channels.sb_rate XYOUTS,t1,sw_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,swinfo,COLOR=7 ENDIF ENDIF ENDIF ;ENDIF ENDIF ELSE BEGIN ; No OSes, so, just update SSR1 and RT for nominal HK and GT-dumps (if any): PLOT_SSR1_CHANNEL, schedv, 0, prev_hr, full_dumps.rate(0,*), $ channels.ssr1_capacity, channels.ssr1_vol, $ x_tdump, s1_ybot, s1_ytop, s1_ylimit, arrx, secs, startdis, $ enddis, ssr1_pct_start, channels.sb_rate, full_dumps XYOUTS,t1,s1_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,s1info,COLOR=7 PLOT_RT_CHANNEL,schedv, 0, prev_hr, full_dumps.rate(3,*), rt_capacity, $ x_tdump, rt_ybot, rt_ytop, rt_ylimit, arrx, secs, startdis, enddis XYOUTS,t1,rt_y50, FONT=-1,ALIGN=0,CHARSIZE=charsize,rtinfo,COLOR=7 ENDELSE WRAP_UP: schedv.x = !x schedv.y = !y schedv.p = !p !P.MULTI = 0 WIDGET_CONTROL,mdiag,SET_VALUE='Plot Update Done.' END