;+ ;$Id: os_summary_1line.pro,v 1.15 2009/09/11 20:28:15 esfand Exp $ ; ; Project : STEREO - SECCHI ; ; Name : OS_SUMMARY_1LINE ; ; Purpose : This routine looks in the defined_os_arr and outputs ; an ascii summary of all OS's. ; ; Use : OS_SUMMARY_1LINE, sname ; ; Inputs : None ; ; Opt. Inputs : sname IF no sname is provided, output is made to the ; screen, otherwise, output is to the sname file. ; ; Outputs : None ; ; Opt. Outputs: None ; ; Keywords : None ; ; Prev. Hist. : Adapted from SOHO/LASCO planning tool. ; ; Written by : Ed Esfandiari, NRL, May 2004 - First Version. ; ; Modification History: ; Ed Esfandiari 06/07/04 - Print os_num using 4-digits. ; Ed Esfandiari 06/07/04 - Display SCIP exptimes without the 1024 factor. ; Ed Esfandiari 06/22/04 - Use lamp descriptions from a save set. ; Ed Esfandiari 06/29/04 - Display all images in a seq using the actual start times. ; Ed Esfandiari 07/14/04 - Use 4 ROI tables instead of 1. ; Ed Esfandiari 07/19/04 - display COR image b4 HI image if scheduled at same time. ; Ed Esfandiari 08/05/04 - Added date-obs and commanded exp.time comment. ; Ed Esfandiari 09/20/04 - Added fps and sync to output. ; Ed Esfandiari 09/29/04 - Changed sync to sc selected. ; Ed Esfandiari 10/07/04 - Direct output to SC_A or SC_B. ; Ed Esfandiari 12/06/04 - Set HI summed sequences Pixel Summing since they ; imply an implicit summing. ; Ed Esfandiari 12/07/04 - Added ImgCnt to output. ; Ed Esfandiari 12/13/04 - Report non cal image exptimes corrected for CCD summing. ; Ed Esfandiari 01/10/05 - Added lowgain exptime correction. ; Ed Esfandiari 01/21/05 - Removed date-obs and commanded exp.time comment. ; Ed Esfandiari 01/27/05 - Added implicit pixel summing for non seq images going ; to a summing buffer (steps 37 or 38). ; Ed Esfandiari 04/18/05 - Added functions/steps 52 and 53 which contain pixel summing ; to the pixel summing checks. ; Ed Esfandiari 05/03/05 Added Run Script (A), commands, if any, to output. ; Ed Esfandiari 05/09/05 - Modified to allow multiple init timeline commands. ; Ed Esfandiari 05/11/05 - Modified to allow multiple Run Script commands. ; Ed Esfandiari 08/01/05 - Added destination info to the summary lines. ; Ed Esfandiari 01/13/06 - changed checks for steps 34 and 36 to 37 and 38. ; Ed Esfandiari 03/09/06 - corrected door statement for multi door operations. ; Ed Esfandiari 04/21/06 - Added table usage information to the summary file. ; Ed Esfandiari 05/09/06 - Allow 8.* filenames for Run Scripts. ; Ed Esfandiari 05/23/06 - Added PT filename info and removed $ from table info. ; Ed Esfandiari 09/01/06 - Added GT rates. ; Ed Esfandiari 11/21/06 - Ignore ccd_sum and low gain exptime correction (FSW does not do it). ; Ed Esfandiari 11/22/06 - Added ccd gain info (HG and LG) to the summary file. ; Ed Esfandiari 11/30/06 - Removed Filter/Polar settings for Darks. ; Ed Esfandiari 12/04/06 - Added compression info to summary output. ; Ed Esfandiari 01/10/07 - Adde iptable numbers to the output. ; Ed Esfandiari 02/08/07 - Use new comp_factors file (telescope specific factors). ; Ed Esfandiari 02/28/07 - Remove dest+compr info for hdr only HI summed images. ; Ed Esfandiari 06/22/07 - Added telemetry volume usage to the summary file. ; Ed Esfandiari 10/17/07 - Use temp. exposures (tmp_exp) from SC-A and B only to ; display correct exposures in summary file in case A and B values ; are not the same. ; Ed Esfandiari 11/02/07 - Use defined exp. (def_ex) for Dark and LED images. ; Ed Esfandiari 08/28/09 - Changed H-compress range from 5-17 to 5-15. ; Also added new HI sample, HI word, and LO word IP function ; effects on image processing. ; Ed Esfandiari 08/28/09 - Changed order of apid and compression for images with multiple ; apid and comp. to "apid comp, apid comp, ..." instead of all ; apids followed by all compressions. ; ; $Log: os_summary_1line.pro,v $ ; Revision 1.15 2009/09/11 20:28:15 esfand ; use 3-digit decimals to display volumes ; ; Revision 1.10 2006/04/06 15:28:25 esfand ; changed checks for steps 34 and 36 to 37 and 38 ; ; Revision 1.9 2005/10/17 19:02:10 esfand ; Added Icer+Mission Sim call. roll Synoptic 20060724000 ; ; Revision 1.8 2005/05/26 20:00:58 esfand ; PT version used to create SEC20050525005 TVAC schedule ; ; Revision 1.7 2005/04/27 20:38:38 esfand ; these were used for 4/21/05 synoptics ; ; Revision 1.6 2005/03/10 16:47:48 esfand ; changes since Jan24-05 to Mar10-05 ; ; Revision 1.5 2005/01/24 17:56:34 esfand ; checkin changes since SCIP_A_TVAC ; ; Revision 1.3 2004/09/08 15:34:45 esfand ; lined-up door/gt cmnds with image commands ; ; Revision 1.2 2004/09/01 15:40:45 esfand ; commit new version for Nathan. ; ; Revision 1.1.1.2 2004/07/01 21:19:05 esfand ; first checkin ; ; Revision 1.1.1.1 2004/06/02 19:42:36 esfand ; first checkin ; ; ;- PRO ADD_DOOR_SUMMARY,times,tel,dlp,door_cmnds,cntr,spacecraft,schedv_sc IF (DATATYPE(times) NE 'DOU') THEN RETURN dtimes= times sc= spacecraft ocnt= N_ELEMENTS(dtimes) ok= INDGEN(ocnt) IF (schedv_sc EQ 1) THEN ok= WHERE(sc EQ 'A', ocnt) IF (schedv_sc EQ 2) THEN ok= WHERE(sc EQ 'B', ocnt) IF (ocnt GT 0) THEN BEGIN dtimes= dtimes(ok) sc= sc(ok) ENDIF ELSE dtimes= -1 IF (DATATYPE(dtimes) EQ 'DOU') THEN BEGIN ct= STRMID(UTC2STR(TAI2UTC(dtimes),/ECS),0,19) IF (dlp EQ 8) THEN BEGIN ; closed doors slp= 'Door Close 0001' kcd= WHERE(ct GT '2003/12/31', kcnt) ENDIF ELSE BEGIN ; open doors (dlp=9) slp= 'Door Open 0001' kcd= WHERE(ct GT '2003/12/31' AND ct LT '2500/01/01', kcnt) ENDELSE IF(kcnt GT 0) THEN BEGIN FOR i= 0, kcnt-1 DO BEGIN cntr= cntr+1 scid='' IF (schedv_sc EQ 0) THEN scid= ' '+sc(kcd(i)) door_cmnds= [door_cmnds,ct(kcd(i))+STRING(cntr,FORMAT='(i5)')+' '+tel+ $ ' '+slp+scid] ENDFOR ENDIF ENDIF RETURN END PRO ADD_GT_SUMMARY,stime,etime,apid,lp,gt_cmnds,cntr,gt_sc,sc,rates IF (DATATYPE(stime) EQ 'DOU') THEN BEGIN wcnt= N_ELEMENTS(gt_sc) w= INDGEN(wcnt) IF (sc EQ 1) THEN w= WHERE(gt_sc EQ 'A' OR gt_sc EQ 'AB', wcnt) IF (sc EQ 2) THEN w= WHERE(gt_sc EQ 'B' OR gt_sc EQ 'AB', wcnt) IF (wcnt GT 0) THEN BEGIN stm= STRMID(UTC2STR(TAI2UTC(stime(w)),/ECS),0,19) etm= STRMID(UTC2STR(TAI2UTC(etime(w)),/ECS),0,19) rte= ' '+STRING(rates(w),'(I6)')+' bps' scid= gt_sc(w) gcnt= N_ELEMENTS(stm) apids= apid(w)+' ' apids= STRMID(apids,0,7) ; longest apid is 7 characters ('GndTest'). Make all the same length ;glp= ' GTdump-' glp= ' GTdump-' FOR i= 0, gcnt-1 DO BEGIN cntr= cntr+1 tsc='' trte='' ;IF (gt_sc(w(i)) EQ 'AB') THEN tsc= ' AB' IF (sc EQ 0) THEN tsc= ' '+scid(i) ;gt_cmnds= [gt_cmnds,stm(i)+STRING(cntr,FORMAT='(i5)')+' - '+etm(i)+glp+apids(i)+' 0002'+tsc] gt_cmnds= [gt_cmnds,stm(i)+STRING(cntr,FORMAT='(i5)')+' - '+etm(i)+ rte(i)+glp+apids(i)+' 0002'+tsc] ENDFOR ENDIF ENDIF RETURN END PRO OS_SUMMARY_1LINE, sname ; IF no sname is provided, output is made to the screen, instead. COMMON OP_SCHEDULED COMMON OS_DEFINED COMMON OS_SCHEDULED 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 ; AEE 12/29/03 COMMON DIALOG, mdiag,font COMMON CMD_SEQ_SCHEDULED ; AEE - 02/22/03 COMMON SCIP_DOORS_SHARE ; AEE - 06/09/03 - add door close/open commands. COMMON GT_DUMPS_SHARE ; AEE - 07/25/03 COMMON LP_CAL_LAMP_SHARE, lpcalv ; AEE - 08/20/03 COMMON SCHED_SHARE, schedv COMMON INIT_TL, ic COMMON RUN_SCRIPT, rsc COMMON TABLES_IN_USE, tables_used, tbAout,tbBout COMMON OS_ALL_SHARE, ccd, ip, ipd, ex, exd, occ_blocks, roi_blocks, fpwl, fpwld COMMON TM_DATA ; AEE - 06/09/03 Add SCIP door commands to the summary file: eucnt= 0 IF (DATATYPE(sc_euvi) NE 'UND') THEN BEGIN IF (sc_euvi(0) NE '') THEN BEGIN IF (schedv.sc EQ 0) THEN eucnt= 1 IF (schedv.sc EQ 1) THEN tmp= WHERE(sc_euvi EQ 'A', eucnt) IF (schedv.sc EQ 2) THEN tmp= WHERE(sc_euvi EQ 'B', eucnt) ENDIF ENDIF c1cnt= 0 IF (DATATYPE(sc_cor1) NE 'UND') THEN BEGIN IF (sc_cor1(0) NE '') THEN BEGIN IF (schedv.sc EQ 0) THEN c1cnt= 1 IF (schedv.sc EQ 1) THEN tmp= WHERE(sc_cor1 EQ 'A', c1cnt) IF (schedv.sc EQ 2) THEN tmp= WHERE(sc_cor1 EQ 'B', c1cnt) ENDIF ENDIF c2cnt= 0 IF (DATATYPE(sc_cor2) NE 'UND') THEN BEGIN IF (sc_cor2(0) NE '') THEN BEGIN IF (schedv.sc EQ 0) THEN c2cnt= 1 IF (schedv.sc EQ 1) THEN tmp= WHERE(sc_cor2 EQ 'A', c2cnt) IF (schedv.sc EQ 2) THEN tmp= WHERE(sc_cor2 EQ 'B', c2cnt) ENDIF ENDIF gtcnt= 0 ;IF (DATATYPE(sc_gt) NE 'UND') THEN BEGIN IF (DATATYPE(sc_gt) NE 'UND') THEN BEGIN IF (sc_gt(0) NE '') THEN BEGIN IF (schedv.sc EQ 0) THEN gtcnt= 1 IF (schedv.sc EQ 1) THEN tmp= WHERE(sc_gt EQ 'A' OR sc_gt EQ 'AB', gtcnt) IF (schedv.sc EQ 2) THEN tmp= WHERE(sc_gt EQ 'B' OR sc_gt EQ 'AB', gtcnt) ENDIF ENDIF title2= '' ; AEE 9/25/03 tltime= '' CASE schedv.sc OF 0: BEGIN ic_cnt= N_ELEMENTS(ic)-1 ; 1st element is not used IF (ic_cnt GT 0) THEN tltime= STRARR(ic_cnt) FOR icntr=0, ic_cnt-1 DO BEGIN tltime(icntr)= ' '+TAI2UTC(ic(icntr+1).dt,/ECS,/TRUNCATE)+ $ ' Initialize Timeline (SC-'+ic(icntr+1).sc+')' ENDFOR READ_EXP_TABLES,GETENV_SLASH('TABLES')+'expostba.img',tmp_exp,tmp_fw_pos,tmp_pw_pos END 1: BEGIN itind= WHERE(ic.sc EQ 'A', ic_cnt) IF (ic_cnt GT 0) THEN tltime= STRARR(ic_cnt) FOR icntr=0, ic_cnt-1 DO BEGIN tltime(icntr)= ' '+TAI2UTC(ic(itind(icntr)).dt,/ECS,/TRUNCATE)+ $ ' Initialize Timeline' ENDFOR READ_EXP_TABLES,GETENV_SLASH('TABLES')+'expostba.img',tmp_exp,tmp_fw_pos,tmp_pw_pos END 2: BEGIN itind= WHERE(ic.sc EQ 'B', ic_cnt) IF (ic_cnt GT 0) THEN tltime= STRARR(ic_cnt) FOR icntr=0, ic_cnt-1 DO BEGIN tltime(icntr)= ' '+TAI2UTC(ic(itind(icntr)).dt,/ECS,/TRUNCATE)+ $ ' Initialize Timeline' ENDFOR READ_EXP_TABLES,GETENV_SLASH('TABLES')+'expostbb.img',tmp_exp,tmp_fw_pos,tmp_pw_pos END ENDCASE rstime= '' CASE schedv.sc OF 0: BEGIN ic_cnt= N_ELEMENTS(rsc)-1 ; 1st element is not used IF (ic_cnt GT 0) THEN rstime= STRARR(ic_cnt) FOR icntr=0, ic_cnt-1 DO BEGIN ;rsfn= STRMID(rsc(icntr+1).fn,STRLEN(rsc(icntr+1).fn)-12,12) rsfn= STRMID(rsc(icntr+1).fn,RSTRPOS(rsc(icntr+1).fn,'.')-8,20) rstime(icntr)= ' '+TAI2UTC(rsc(icntr+1).dt,/ECS,/TRUNCATE)+' RunScript '+ $ rsfn+' (SC-'+rsc(icntr+1).sc+')' ENDFOR END 1: BEGIN itind= WHERE(rsc.sc EQ 'A', ic_cnt) IF (ic_cnt GT 0) THEN rstime= STRARR(ic_cnt) FOR icntr=0, ic_cnt-1 DO BEGIN ;rsfn= STRMID(rsc(itind(icntr)).fn,STRLEN(rsc(itind(icntr)).fn)-12,12) rsfn= STRMID(rsc(itind(icntr)).fn,RSTRPOS(rsc(itind(icntr)).fn,'.')-8,20) rstime(icntr)= ' '+TAI2UTC(rsc(itind(icntr)).dt,/ECS,/TRUNCATE)+' RunScript '+ $ rsfn ENDFOR END 2: BEGIN itind= WHERE(rsc.sc EQ 'B', ic_cnt) IF (ic_cnt GT 0) THEN rstime= STRARR(ic_cnt) FOR icntr=0, ic_cnt-1 DO BEGIN ;rsfn= STRMID(rsc(itind(icntr)).fn,STRLEN(rsc(itind(icntr)).fn)-12,12) rsfn= STRMID(rsc(itind(icntr)).fn,RSTRPOS(rsc(itind(icntr)).fn,'.')-8,20) rstime(icntr)= ' '+TAI2UTC(rsc(itind(icntr)).dt,/ECS,/TRUNCATE)+' RunScript '+ $ rsfn ENDFOR END ENDCASE IF (DATATYPE(os_arr(0)) EQ 'INT' AND eucnt EQ 0 AND $ c1cnt EQ 0 AND c2cnt EQ 0 AND gtcnt EQ 0) THEN BEGIN IF (tltime(0) NE '' OR rstime(0) NE '') THEN BEGIN str_arr_all= '' GOTO, ITL_ONLY ENDIF WIDGET_CONTROL,mdiag,SET_VALUE="%%OS_SUMMARY_1LINE: No OS's, DOORs, or GT-dumps scheduled" PRINT, "%%OS_SUMMARY_1LINE: No OS's, DOORs, or GT-dumps scheduled" RETURN ENDIF ; IF (DATATYPE(os_arr(0)) EQ 'INT' AND $ ; DATATYPE(cdoor_euvi) NE 'DOU' AND DATATYPE(odoor_euvi) NE 'DOU' AND $ ; DATATYPE(cdoor_cor1) NE 'DOU' AND DATATYPE(odoor_cor1) NE 'DOU' AND $ ; DATATYPE(cdoor_cor2) NE 'DOU' AND DATATYPE(odoor_cor2) NE 'DOU' AND $ ; DATATYPE(stime_gt) NE 'DOU' AND DATATYPE(etime_gt) NE 'DOU') THEN BEGIN ; AEE - 7/25/03 - GT dumps ; ; WIDGET_CONTROL,mdiag,SET_VALUE="%%OS_SUMMARY_1LINE: No OS's, DOORs, or GT-dumps scheduled" ; PRINT, "%%OS_SUMMARY_1LINE: No OS's, DOORs, or GT-dumps scheduled" ; RETURN ; ENDIF ;title2= '' ; AEE 9/25/03 door_cmnds= '' cntr= 0 ADD_DOOR_SUMMARY,cdoor_euvi,'EUVI',8,door_cmnds,cntr,sc_euvi,schedv.sc ;close-doors EUVI (tel=0, lp=8) ADD_DOOR_SUMMARY,odoor_euvi,'EUVI',9,door_cmnds,cntr,sc_euvi,schedv.sc ; open-doors EUVI (tel=0, lp=9) ADD_DOOR_SUMMARY,cdoor_cor1,'COR1',8,door_cmnds,cntr,sc_cor1,schedv.sc ;close-doors COR1 (tel=1, lp=8) ADD_DOOR_SUMMARY,odoor_cor1,'COR1',9,door_cmnds,cntr,sc_cor1,schedv.sc ; open-doors COR1 (tel=1, lp=9) ADD_DOOR_SUMMARY,cdoor_cor2,'COR2',8,door_cmnds,cntr,sc_cor2,schedv.sc ;close-doors COR2 (tel=2, lp=8) ADD_DOOR_SUMMARY,odoor_cor2,'COR2',9,door_cmnds,cntr,sc_cor2,schedv.sc ; open-doors COR2 (tel=2, lp=9) gt_cmnds= '' ;ADD_GT_SUMMARY,stime_gt,etime_gt,apid_gt,10,gt_cmnds,cntr,sc_gt,schedv.sc ; LP=10 ADD_GT_SUMMARY,stime_gt,etime_gt,apid_gt,10,gt_cmnds,cntr,sc_gt,schedv.sc,rate_gt ; LP=10 IF (N_PARAMS() EQ 1) THEN BEGIN IF (STRPOS(sname,'SEC2') GE 0) THEN BEGIN WIDGET_CONTROL,mdiag,SET_VALUE='%%CREATING SUMMARY FILE: '+sname PRINT,'%%CREATING SUMMARY FILE: ',sname ENDIF ELSE BEGIN WIDGET_CONTROL,mdiag,SET_VALUE='%%CREATING SUMMARY FILE: Verify Schedule.' PRINT,'%%CREATING SUMMARY FILE: Verify Schedule.' ENDELSE ENDIF IF (DATATYPE(os_arr(0)) EQ 'INT') THEN GOTO, door_or_gt_only os_arr2 = os_arr(SORT([os_arr.os_num])) ;** sort on os_num uniq_os_arr2 = os_arr2(UNIQ([os_arr2.os_num])) num_os = N_ELEMENTS(uniq_os_arr2) IF (SEXIST(tele_types) EQ 0) THEN OS_INIT ;** define some variables ; Read compression factors: filename= GETENV('PT')+'/IN/OTHER/comp_factors.dat' make_cf_arr, filename, cf_full,cf_ipsum str_arr_all = '' ;counter = 0 FOR i = num_os-1, 0, -1 DO BEGIN ;** for every unique os_num os_num = uniq_os_arr2(i).os_num osind = WHERE(defined_os_arr.os_num EQ os_num AND defined_os_arr.num_images GT 0,cnt) ; AEE - Mar 19, 03 IF (cnt EQ 0) THEN GOTO, CONT IF(defined_os_arr(osind(0)).lp EQ 6) THEN BEGIN ; AEE - 01/28/03 hi_seq_images= 0 FOR hsi= 0, cnt-1 DO hi_seq_images= hi_seq_images + defined_os_arr(osind(hsi)).num_images hi_seq_images= STRTRIM(FIX(STRING(hi_seq_images)),2) ENDIF FOR ind1= 0, cnt-1 DO BEGIN ; since HI seq has a two entry os_num (one for HI1 and one for HI2). ind= osind(ind1) os = defined_os_arr(ind) lp = defined_os_arr(ind).lp tele = defined_os_arr(ind).tele fw = defined_os_arr(ind).fw pw = defined_os_arr(ind).pw exptable = defined_os_arr(ind).exptable ; AEE 1/14/04 camtable = defined_os_arr(ind).camtable ; AEE 1/14/04 fps = defined_os_arr(ind).fps ; AEE 1/14/04 ;sync = defined_os_arr(ind).sync ; AEE 1/14/04 iptable = defined_os_arr(ind).iptable lamp = defined_os_arr(ind).lamp start = defined_os_arr(ind).start num_images = defined_os_arr(ind).num_images tccd = defined_os_arr(ind).ccd tip = defined_os_arr(ind).ip ;tex = defined_os_arr(ind).ex def_ex= defined_os_arr(ind).ex tex= tmp_exp occ_blks = REFORM(defined_os_arr(ind).occ_blocks(tele,*)) roi_blks = REFORM(defined_os_arr(ind).roi_blocks(tele,*)) ; AEE 5/5/04: indm = WHERE(tip(iptable).steps EQ 28) ; 28 = don't use occ mask table. IF (indm(0) GE 0) THEN useocc = 0 ELSE useocc = 1 ; Also see os_get_num_pixels.pro ; generate_ipt.pro ; generate_ipt_set.pro ; os_summary.pro ; os_summary_1line.pro ; os_summary_set.pro ; os_summary_text.pro ;indm = WHERE(tip(iptable).steps EQ 25) ;IF (indm(0) LT 0) THEN useroi = 0 ELSE useroi = 1 roi_table= WHICH_ROI_TABLE(tip,iptable) IF (roi_table EQ -1) THEN useroi = 0 ELSE useroi = 1 CASE (1) OF ((useocc EQ 1) AND (useroi EQ 0)) : BEGIN blocks = WHERE(occ_blks GT 0,num) blockstr = 'Occulter (' + STRTRIM(num,2) + ' blocks)' END ((useroi EQ 1) AND (useocc EQ 0)) : BEGIN blocks = WHERE(roi_blks GT 0,num) blockstr = 'ROI (' + STRTRIM(num,2) + ' blocks)' END ((useroi EQ 1) AND (useocc EQ 1)) : BEGIN blocks = WHERE((occ_blks+roi_blks) GT 0,num) blockstr = 'Occulter & ROI (' + STRTRIM(num,2) + ' blocks)' END ELSE : BEGIN blocks = -1 blockstr = 'None' END ENDCASE ;tos_num = ' '+STRTRIM(STRING(os_num),2) ;IF (ind1 EQ 1) THEN tos_num = ' -'+STRTRIM(STRING(os_num),2) ;AE -02/05/03 for 2nd HI of LP=6 use -os_num tos_num = ' '+STRING(os_num,FORMAT='(I4.4)') IF (ind1 EQ 1) THEN tos_num = ' -'+STRING(os_num,FORMAT='(I4.4)') ; for 2nd HI of LP=6 use -os_num ttele = ' '+STRMID(tele_types(tele),11,4) tlp = ' '+STRMID(STRING(op_types(lp))+' ',0,12)+' ' ; AEE - 9/25/03 - left justify tfw = ' '+STRING(FILTER2STR(fw_types,exptable,fw,tele), FORMAT='(a7)')+' ' ; AEE 4/5/04 ccd1 = tccd(tele,camtable) ; AEE 1/14/04 tnx = STRING((ccd1.x2 - ccd1.x1+1), FORMAT='(i5)') tny = STRING((ccd1.y2 - ccd1.y1+1), FORMAT='(i5)') xs = ccd1.xsum > 1 ys = ccd1.ysum > 1 tsum=' '+STRING(xs, FORMAT='(i1)')+'x'+STRING(ys, FORMAT='(i1)') ;** check for LEB summing ;** check for SEB (Pixel) summing: ;good = WHERE(tip(iptable).steps EQ 3, nip) ; AEE - 01/13/03 IF (lp EQ 6) THEN BEGIN ; HI summed Sequences (have step 34 or 36) are implicitly summed to ; 1024x1024 (Pixel Summing), so set it in the summary file: good = WHERE(tip(iptable).steps EQ 3 OR $ tip(iptable).steps EQ 52 OR $ tip(iptable).steps EQ 53 OR $ ; tip(iptable).steps EQ 34 OR $ ; tip(iptable).steps EQ 36, nip) ; AEE - 01/13/03 tip(iptable).steps EQ 37 OR $ tip(iptable).steps EQ 38, nip) ENDIF ELSE BEGIN ; Also can have non seq images going to a summing buffer (steps 37 or 38) ; which are also implicitly summed: good = WHERE(tip(iptable).steps EQ 3 OR $ tip(iptable).steps EQ 52 OR $ tip(iptable).steps EQ 53 OR $ tip(iptable).steps EQ 37 OR $ tip(iptable).steps EQ 38, nip) ENDELSE nip = 2^nip > 1 tlsum=' '+STRING(nip, FORMAT='(i2)')+'x'+STRTRIM(STRING(nip, FORMAT='(i2)'),2) IF(nip LE 8) THEN tlsum= tlsum+' ' ind2 = WHERE(os_arr.os_num EQ os_num AND os_arr.os_tele EQ tele) ; FOR HI Seq pickup only HI1 or HI2 num_scheduled = N_ELEMENTS(ind2) FOR s=0, num_scheduled-1 DO BEGIN ;** loop over num_scheduled ;For non cal images, report exptime that is corrected for CCD summing: ccdsum= 1 IF (lp NE 2 AND lp NE 3) THEN BEGIN ccdsum= ((xs > 1) * (ys > 1)) IF (ccd1.gmode EQ 1) THEN ccdsum= ccdsum/4.0 ; for low gain, amplify exptime by 4 ENDIF ccdsum=1 ; Ignore ccd_sum and low gain exptime correction (FSW does not do it). ; Add ccd gain mode (hi or low) to the summary file: gmode= ' HG ' IF (ccd1.gmode EQ 1) THEN gmode=' LG ' os_start = os_arr(ind2(s)).os_start sc= os_arr(ind2(s)).sc IF (sc EQ 'AB') THEN sc= sc+'-Synced' IF (lp EQ 5 or lp EQ 6) THEN BEGIN expand_os= EXPAND_SEQ(os_arr(ind2(s))) os_start= expand_os.os_start ENDIF ;tdate_obs = STRMID(UTC2STR(TAI2UTC(os_start), /ECS),0,19) ; also need ":ss" for secchi date_str = STRMID(UTC2STR(TAI2UTC(os_start), /ECS),0,19) ; also need ":ss" for secchi tdate_obs= date_str(0) IF (lp EQ 7) THEN BEGIN ;** Block Seq (never gets here since lp=7 is expanded to os_nums) str = tdate_obs+ ' Block Seq Table Entry '+STRTRIM(start,2)+ $ ' to Entry '+STRTRIM(num_images,2) str_arr_all = [str_arr_all, str] ENDIF ELSE BEGIN ;filename= GETENV('PT')+'/IN/OTHER/'+'exposure_cnvt_factors.sav' ;RESTORE, filename ;=> HI_EXP_FACTOR=1000 and SCIP_EXP_FACTOR=1024.0 ;scip_exp_factor= 1000.0 ; dispay scip exptimes without applying the 1024 factor. ; For cal lamps, expsures are actually pulses so don't convert them: ;IF (lp EQ 3) THEN BEGIN ; scip_exp_factor= 1.0 ; hi_exp_factor= 1.0 ;ENDIF tpw_exp2= '' ; AEE 9/25/03 FOR n=0, num_images -1 DO BEGIN ; ** for each pw position in the seq (for ; non-seq num_images=1 always) tdate_obs = date_str(n) IF tele LE 2 THEN BEGIN ; change SCIP exp from ms to sec (for SCIP 1sec=1024ms) ; AEE 12/19/03 - for SCIP seq add image number in front of PW so sort does not change ; the order of selected PW positions: bk= ' ' tpw = bk+STRING(POLAR2STR(pw_types,exptable,pw(n),tele), FORMAT='(a7)') ; AEE 4/5/04 IF (lp EQ 5 AND num_images GT 1) THEN BEGIN tlp= STRMID(tlp,0,10)+' '+STRTRIM(n+1,2)+'/'+STRTRIM(num_images,2)+' ' ENDIF ;IF (lp EQ 3) THEN $ ; AEE - 11/18/03 - report cal lamps in pulses (maybe 6 digits). IF (lp EQ 2 OR lp EQ 3) THEN $ ; AEE - 11/18/03 - report cal lamps in pulses (maybe 6 digits). texp=' '+STRING(def_ex(tele,exptable,fw,pw(n))/ccdsum,FORMAT='(I7)') $ ELSE $ texp=' '+STRING(tex(tele,exptable,fw,pw(n))/ccdsum,FORMAT='(I7)') IF (lp EQ 0) THEN BEGIN ; AEE - 9/24/03 ; For double sky images, add the second pw and exp.time (for these images n is ; always 0) and pw(1) indicates the second pw positions and exptime to be used. tpw_exp2= ' ('+ POLAR2STR(pw_types,exptable,pw(1),tele)+' , '+ $ ; AEE 4/5/04 STRTRIM(STRING(tex(tele,exptable,fw,pw(1))/ccdsum,FORMAT='(I7)'),2)+')' ENDIF ENDIF ELSE BEGIN ; change HI exp from ms to sec (for HI 1sec= 1000ms) ; AEE - 01/23/03 - HI has no polar (and pw is only a 20 element array): tpw = ' '+STRING(POLAR2STR(pw_types,exptable,pw(0),tele), FORMAT='(a7)') ;IF (lp EQ 3) THEN $ ; AEE - 11/18/03 - report cal lamps in pulses (maybe 6 digits). IF (lp EQ 2 OR lp EQ 3) THEN $ ; AEE - 11/18/03 - report cal lamps in pulses (maybe 6 digits). texp=' '+STRING(def_ex(tele,exptable,fw,pw(0))/ccdsum,FORMAT='(I7)') $ ELSE $ texp=' '+STRING(tex(tele,exptable,fw,pw(0))/ccdsum,FORMAT='(I7)') IF (lp EQ 0) THEN BEGIN ; AEE - 9/24/03 ;Note: HI telescpes do not have a shtter, polarizer, or filter wheels so pw(0) ;is only used. tpw_exp2= ' ('+POLAR2STR(pw_types,exptable,pw(0),tele)+' , '+ $ STRTRIM(STRING(tex(tele,exptable,fw,pw(0))/ccdsum,FORMAT='(I7)'),2)+')' ENDIF ENDELSE ;IF (lp EQ 4) THEN texp = ' '+STRING(0.0,FORMAT='(F6.1)') ; AEE 10/7/03 IF (lp EQ 4) THEN texp = ' '+STRING(0.0,FORMAT='(I7)') ; AEE 10/7/03 ;counter = counter+1 ;tcntr = STRING(counter,FORMAT='(i4)') cntr= cntr+1 tcntr = STRING(cntr,FORMAT='(i5)') ; AEE - 7/29/03 - only show the last image of a HI-seq: IF (lp EQ 6) THEN BEGIN this_image= n+1 IF (ind1 EQ 1) THEN this_image= this_image + defined_os_arr(osind(0)).num_images hi_seq_img= STRTRIM(FIX(STRING(this_image)),2)+'/'+hi_seq_images tlp = STRMID(' '+STRTRIM(STRING(op_types(lp)),2)+' '+hi_seq_img+' ',0,15) ENDIF IF (lp EQ 3) THEN BEGIN RESTORE, FILENAME= GETENV('PT')+'/IN/OTHER/secchi_cal_leds.sav' ; => euvi_lamps, cor1_lamps, cor2_lamps, hi1_lamps, hi2_lamps CASE tele of 0: lamp_used= ' (' +euvi_lamps(lamp)+')' 1: lamp_used= ' (' +cor1_lamps(lamp)+')' 2: lamp_used= ' (' +cor2_lamps(lamp)+')' 3: lamp_used= ' (' +hi1_lamps(lamp)+')' 4: lamp_used= ' (' +hi2_lamps(lamp)+')' ENDCASE ;tlp = STRMID(' Cal'+lamp_used+' ',0,15) tlp = STRMID(' LED'+lamp_used+' ',0,15) ENDIF ; If image is dark, set filter and polar to blanks: IF (STRPOS(tlp,'Dark') GT 0) THEN BEGIN tfw=' ' tpw=' ' ENDIF ;str= tdate_obs+tcntr+ ttele+ texp+ tnx+ tny+ tsum+tlsum+ tfw+ tpw+ tlp+ tos_num+ tpw_exp2 str= tdate_obs+tcntr+ ttele+ texp+ tnx+ tny+gmode+tsum+tlsum+ tfw+ tpw+ tlp+ tos_num+ tpw_exp2 IF (schedv.sc EQ 0) THEN BEGIN str= str+' '+sc ENDIF ELSE BEGIN IF (sc EQ 'AB-Synced') THEN str= str+' '+sc ENDELSE ; Also add destination(s) to summary: 7/28/05 ;dest= ['SSR1+RT','SW','SSR1','SSR2','GNDTST'] ;dest= WHERE(tip(iptable).steps GE 39 AND tip(iptable).steps LE 44,destcnt) dest= WHERE(tip(iptable).steps GE 39 AND tip(iptable).steps LE 43,destcnt) dstr='' ip_str='' special_hi='' FOR di= 0, destcnt-1 DO BEGIN CASE tip(iptable).steps(dest(di)) OF 39: dstr= dstr+' SSR1+RT' 40: dstr= dstr+' SW' 41: dstr= dstr+' SSR1' 42: dstr= dstr+' SSR2' 43: dstr= dstr+' GndTest' ;ELSE: str= str+' dest?' ELSE: dstr= dstr+' dest?' ENDCASE dstr= dstr+'*' ENDFOR ;dstr= ' ('+STRTRIM(dstr,2)+')' ;dstr= ' ('+STRTRIM(dstr,2) IF (lp EQ 6) THEN BEGIN iptable= os.iptable ;honly='HO - ' honly='' sumipt= iptable ; iptable for 1st summed image (middle images and last image use different ip tables) IF (n GT 0 AND n LT os.num_images-1) THEN BEGIN ; pick iptable number for middle images sumipt= FIX((STR_SEP(ip_arr(ipd(iptable).steps(0)).ip_description,' '))(3)) iptable= sumipt honly= '' ENDIF IF (n EQ os.num_images-1) THEN BEGIN ; pickup iptable number for last image sumipt= FIX((STR_SEP(ip_arr(ipd(iptable).steps(1)).ip_description,' '))(3)) iptable= sumipt honly= '' ENDIF ;dest= WHERE(tip(iptable).steps GE 39 AND tip(iptable).steps LE 43,destcnt) dest= WHERE(ipd(iptable).steps GE 39 AND ipd(iptable).steps LE 43,destcnt) ; defined for sumipt dest= [dest,25] ; so that HI/LO checks don't cause error dstr='' special_hi='' FOR di= 0, destcnt-1 DO BEGIN ;CASE tip(iptable).steps(dest(di)) OF CASE ipd(iptable).steps(dest(di)) OF 39: dstr= dstr+' SSR1+RT' 40: dstr= dstr+' SW' 41: dstr= dstr+' SSR1' 42: dstr= dstr+' SSR2' 43: dstr= dstr+' GndTest' ;ELSE: str= str+' dest?' ELSE: dstr= dstr+' dest?' ENDCASE tmp= WHERE(ipd(iptable).steps(dest(di):dest(di+1)-1) EQ 40 OR $ ipd(iptable).steps(dest(di):dest(di+1)-1) EQ 16 OR $ ipd(iptable).steps(dest(di):dest(di+1)-1) EQ 17, spw_cnt) IF (spw_cnt EQ 2) THEN special_hi= special_hi+'Sunside&' tmp= WHERE(ipd(iptable).steps(dest(di):dest(di+1)-1) EQ 120, ip32hi_cnt) tmp= WHERE(ipd(iptable).steps(dest(di):dest(di+1)-1) EQ 121, ip32lo_cnt) IF (ip32hi_cnt GT 0) THEN special_hi= special_hi+'32HI&' IF (ip32lo_cnt GT 0) THEN special_hi= special_hi+'32LO&' special_hi= special_hi+'*' dstr= dstr+'*' ENDFOR ;dstr= ' (IP'+STRING(sumipt,'(I2.2)')+': '+honly+STRTRIM(dstr,2) ip_str= ' (IP'+STRING(sumipt,'(I2.2)')+': '+honly ;help,iptable,dstr ENDIF ELSE BEGIN ;dstr= ' (IP'+STRING(iptable,'(I2.2)')+': '+STRTRIM(dstr,2) ip_str= ' (IP'+STRING(iptable,'(I2.2)')+': ' ENDELSE ;str= str+dstr ;cmpr= WHERE(tip(iptable).steps GE 5 AND tip(iptable).steps LE 17 OR $ ;cmpr= WHERE(tip(iptable).steps GE 5 AND tip(iptable).steps LE 14 OR $ ;cmpr= WHERE(tip(iptable).steps GE 5 AND tip(iptable).steps LE 15 OR $ ; tip(iptable).steps EQ 44 OR $ ; tip(iptable).steps GE 90 AND tip(iptable).steps LE 101,cmprcnt) ; iptable for middle summed images are defines in ipd but maybe not for ; tip (if os is read from .ipt file?): cmpr= WHERE(ipd(iptable).steps GE 5 AND ipd(iptable).steps LE 15 OR $ ipd(iptable).steps EQ 44 OR $ ipd(iptable).steps GE 90 AND ipd(iptable).steps LE 101,cmprcnt) cstr='' ;help,cmpr,cmprcnt ;stop ; Keep none HdrOnly and NoCmpr factors for tele in form of string: IF (nip EQ 1) THEN $ ;comp_str= '='+STRTRIM(STRING(cf_full(tele,2:*),'(f8.2)'),2) $ comp_str= '='+STRTRIM(STRING(cf_full(tele,2:*),'(f8.1)'),2) $ ELSE $ ;comp_str= '='+STRTRIM(STRING(cf_ipsum(tele,2:*),'(f8.2)'),2) comp_str= '='+STRTRIM(STRING(cf_ipsum(tele,2:*),'(f8.1)'),2) FOR di= 0, cmprcnt-1 DO BEGIN ;CASE tip(iptable).steps(cmpr(di)) OF CASE ipd(iptable).steps(cmpr(di)) OF ;5: cstr= cstr+' HdrOnly' 5: cstr= cstr+' Hdr' 6: cstr= cstr+' NoCmpr' 7: cstr= cstr+' Rice'+comp_str(0) 8: cstr= cstr+' HC0'+comp_str(1) 9: cstr= cstr+' HC1'+comp_str(2) 10: cstr= cstr+' HC2'+comp_str(3) 11: cstr= cstr+' HC3'+comp_str(4) 12: cstr= cstr+' HC4'+comp_str(5) 13: cstr= cstr+' HC5'+comp_str(6) 14: cstr= cstr+' HC6'+comp_str(7) ;15: cstr= cstr+' HC7'+comp_str(8) ;16: cstr= cstr+' HC8'+comp_str(9) ;17: cstr= cstr+' HC9'+comp_str(10) 15: cstr= cstr+' Sample' 90: cstr= cstr+' IC0'+comp_str(11) 91: cstr= cstr+' IC1'+comp_str(12) 92: cstr= cstr+' IC2'+comp_str(13) 93: cstr= cstr+' IC3'+comp_str(14) 94: cstr= cstr+' IC4'+comp_str(15) 95: cstr= cstr+' IC5'+comp_str(16) 96: cstr= cstr+' IC6'+comp_str(17) 97: cstr= cstr+' IC7'+comp_str(18) 98: cstr= cstr+' IC8'+comp_str(19) 99: cstr= cstr+' IC9'+comp_str(20) 100: cstr= cstr+' IC10'+comp_str(21) 101: cstr= cstr+' IC11'+comp_str(22) ELSE: cstr= cstr+' cmpr?' ENDCASE ;cstr= cstr+'*' cstr= cstr+'*' ENDFOR ; cstr= ','+STRTRIM(cstr,2)+')' ; str= str+cstr iptable= os.iptable ; so, Hi summed mid images iptable is not used. dstr= STR_SEP(dstr,'*') cstr= STR_SEP(cstr,'*') special_hi= STR_SEP(special_hi,'*') ;dc_str= '' ;FOR dc=0, N_ELEMENTS(dstr)-2 DO dc_str= dc_str+dstr(dc)+' '+STRTRIM(cstr(dc),2)+',' ;FOR dc=0, N_ELEMENTS(dstr)-2 DO dc_str= dc_str+dstr(dc)+'<'+STRTRIM(cstr(dc),2)+',' ;dc_str= STRMID(dc_str,0,STRLEN(dc_str)-1) dc_str= ip_str IF (lp EQ 6) THEN BEGIN ; HI-seq FOR dc=0, N_ELEMENTS(dstr)-2 DO dc_str= dc_str+special_hi(dc)+ $ STRTRIM(cstr(dc),2)+'>'+STRTRIM(dstr(dc),2)+', ' ENDIF ELSE BEGIN FOR dc=0, N_ELEMENTS(dstr)-2 DO dc_str= dc_str+STRTRIM(cstr(dc),2)+ $ '>'+STRTRIM(dstr(dc),2)+', ' ENDELSE dc_str= STRMID(dc_str,0,STRLEN(dc_str)-2) str= str+' '+STRTRIM(dc_str,2)+')' ;help,dc_str ;print,str ; Remove dest+compr info for hdr only HI summed images: p= STRPOS(str,'HO - ') ;IF (p GT 0) THEN str= STRMID(str,0,p)+'HdrOnly)' IF (p GT 0) THEN str= STRMID(str,0,p)+'Hdr)' ;print,str ;IF (sync EQ 1) THEN str= str+ ' Sync' IF (fps EQ 1) THEN str= str+ ' FPS' ;hdr_only= WHERE(tip(iptable).steps EQ 5, hcnt) ;IF (hcnt GT 0) THEN str= str+' Hdr-Only' IF (STRLEN(tpw_exp2) GT 0) THEN title2= ' (Polar2,Exp2)' IF (lp NE 6) THEN BEGIN str_arr_all = [str_arr_all, str] ENDIF ELSE BEGIN ; HI sequence ;summed= WHERE(tip(iptable).steps EQ 34 OR tip(iptable).steps EQ 36,scnt) summed= WHERE(tip(iptable).steps EQ 37 OR tip(iptable).steps EQ 38,scnt) IF (scnt GT 0) THEN str= str+' Summed' ; only print last line (i.e. 25/25 line) of a HI seq since everything else ; on all lines including the times are the same: ;IF (n EQ num_images-1) THEN str_arr_all = [str_arr_all, str] ; No, print all HI seq lines (each line/image now has its acutual time). str_arr_all = [str_arr_all, str] ENDELSE ENDFOR ENDELSE END ENDFOR ; ind1 for HI Seq CONT: ENDFOR ; uniqe os str_arr_all = str_arr_all(1:*) ; AEE - 06/09/03 door_or_gt_only: ;AEE - 06/09/03 IF (DATATYPE(str_arr_all) NE 'UND') THEN BEGIN ;str_arr_all = STRMID(str_arr_all,0,20) + STRMID(str_arr_all,24,STRLEN(str_arr_all(0))-1) ; for ":ss" IF (N_ELEMENTS(door_cmnds) GT 1) THEN str_arr_all = [str_arr_all,door_cmnds(1:*)] IF (N_ELEMENTS(gt_cmnds) GT 1) THEN str_arr_all = [str_arr_all,gt_cmnds(1:*)] ENDIF ELSE BEGIN IF (N_ELEMENTS(door_cmnds) GT 1) THEN str_arr_all= door_cmnds(1:*) IF (N_ELEMENTS(gt_cmnds) GT 1) THEN BEGIN IF (DATATYPE(str_arr_all) EQ 'UND') THEN $ str_arr_all = gt_cmnds(1:*) $ ELSE $ str_arr_all = [str_arr_all,gt_cmnds(1:*)] ENDIF ENDELSE inds = SORT(str_arr_all) ;str_arr_all(inds(0)) = ' '+str_arr_all(inds(0)) ;str_arr_all = STRMID(str_arr_all,0,20) + STRMID(str_arr_all,25,STRLEN(str_arr_all(0))-1) ; for ":ss" str_arr_all = STRMID(str_arr_all,0,20) + STRMID(str_arr_all,25,200) ; for ":ss" str_arr_all = str_arr_all(inds) ; do a second sort to move COR images before HI images, if at same time: str_arr_all = str_arr_all(SORT(str_arr_all)) ; str_arr_all(0) = ' '+str_arr_all(0) ;line up first row with the rest. ITL_ONLY: icnt= 0 IF (str_arr_all(0) NE '') THEN BEGIN ; Add a 6 bit image count for images in the schedule: imgcnt= WHERE(STRPOS(str_arr_all,'Door') LT 0 AND $ STRPOS(str_arr_all,'GTdump') LT 0, icnt) IF (icnt GT 0) THEN BEGIN ;simgcnt= STRMID(LINDGEN(icnt)+1,7,5)+' ' ; 5 plus blank = 6 simgcnt= STRMID(LINDGEN(icnt)+1,6,6)+' ' ; 6 plus blank = 7 str_arr_all(imgcnt)= simgcnt+ str_arr_all(imgcnt) ENDIF IF (icnt LT N_ELEMENTS(str_arr_all)) THEN BEGIN ; door/gt present in schedule. use 7 blanks for image count. notimg= WHERE(STRPOS(str_arr_all,'Door') GE 0 OR $ STRPOS(str_arr_all,'GTdump') GE 0, ncnt) ;IF (ncnt GT 0) THEN str_arr_all(notimg)= ' '+str_arr_all(notimg) IF (ncnt GT 0) THEN str_arr_all(notimg)= ' '+str_arr_all(notimg) ENDIF ENDIF ;str_arr_all(0) = ' '+str_arr_all(0) ;line up first row with the rest. ;ttime= 'Unlike upload times, following "Date Obs" are start of image setup times NOT commanded exposure times.' ttime='' tit= 'Exposures are in milliseconds but For Cal. LEDs Exp represents number of pulses.' IF (schedv.sc EQ 0) THEN tit= tit+' S/C= A&B'+ ', ImgCnt= '+STRTRIM(icnt,2) IF (schedv.sc EQ 1) THEN tit= tit+' S/C= A'+ ', ImgCnt= '+STRTRIM(icnt,2) IF (schedv.sc EQ 2) THEN tit= tit+' S/C= B'+ ', ImgCnt= '+STRTRIM(icnt,2) ;title= 'ImgCnt Date Obs Tele Exp Nx Ny CCD SEB Filter Polar SEB Program OS_NUM' ;title= 'ImgCnt Date Obs Tele Exp Nx Ny CCD SEB Filter Polar SEB_Program OS_NUM' title= 'ImgCnt Date Obs Tele Exp Nx Ny Gain CCD SEB Filter Polar SEB_Program OS_NUM' title= title+title2 ; AEE 9/25/03 IF (tltime(0) NE '') THEN BEGIN FOR tl= 0, N_ELEMENTS(tltime)-1 DO BEGIN dates= STRMID(str_arr_all,7,19) ncmnd= N_ELEMENTS(str_arr_all) ;dind= WHERE(dates LT itl_date, dcnt) tonly= STRMID(tltime(tl),7,19) dind= WHERE(dates LT tonly, dcnt) CASE dcnt OF 0: str_arr_all= [tltime(tl),str_arr_all] ncmnd: str_arr_all= [str_arr_all,tltime(tl)] ELSE: str_arr_all= [str_arr_all(0:dcnt-1),tltime(tl),str_arr_all(dcnt:*)] ENDCASE ENDFOR ENDIF IF (rstime(0) NE '') THEN BEGIN FOR tl= 0, N_ELEMENTS(rstime)-1 DO BEGIN dates= STRMID(str_arr_all,7,19) ncmnd= N_ELEMENTS(str_arr_all) tonly= STRMID(rstime(tl),7,19) dind= WHERE(dates LT tonly, dcnt) CASE dcnt OF 0: str_arr_all= [rstime(tl),str_arr_all] ncmnd: str_arr_all= [str_arr_all,rstime(tl)] ELSE: str_arr_all= [str_arr_all(0:dcnt-1),rstime(tl),str_arr_all(dcnt:*)] ENDCASE ENDFOR ENDIF IF (N_PARAMS() EQ 1) THEN BEGIN IF (schedv.sc EQ 0) THEN BEGIN sc= 'SC_A' ; this is called only from verify-schedule and will be deleted. tables= [tbAout,tbBout] ENDIF IF (schedv.sc EQ 1) THEN BEGIN sc= 'SC_A' tables= tbAout ENDIF IF (schedv.sc EQ 2) THEN BEGIN sc= 'SC_B' tables= tbBout ENDIF tables= [';PT Schedule = '+sc+'/SUMMARY/'+sname,tables] OPENW, LUN, GETENV('PT')+'/OUT/'+sc+'/SUMMARY/'+sname, /GET_LUN FOR tb= 0, N_ELEMENTS(tables)-1 DO PRINTF, LUN, tables(tb) PRINTF, LUN,ttime ;IF (STRLEN(sbuf_use) GT 1) THEN BEGIN ;IF (schedv.pct_stats EQ 1) THEN BEGIN tschedv = schedv tschedv.pct_stats= 1 ; set to volume TOGGLE_STATS, tschedv, tschedv.startdis, tschedv.enddis PRINTF, LUN,' Telemetry Volume (MB) for The Period Of '+ $ UTC2STR(TAI2UTC(schedv.startdis), /ECS, /TRUNCATE) + ' to ' +UTC2STR(TAI2UTC(schedv.enddis), /ECS, /TRUNCATE) PRINTF, LUN,' Total EUVI COR1 COR2 HI1 HI2 HK GT' PRINTF, LUN,'SBUF'+sbuf_use PRINTF, LUN,'SSR1'+ssr1_use PRINTF, LUN,'SSR2'+ssr2_use PRINTF, LUN,'RTch'+rt_use PRINTF, LUN,'SWch'+sw_use PRINTF, LUN,ttime ;ENDIF PRINTF, LUN,tit ;PRINTF, LUN, ' r/o size Bining' PRINTF, LUN, ' r/o size Bining' PRINTF, LUN,title ;PRINTF, LUN, str_arr_all(inds) PRINTF, LUN, str_arr_all CLOSE, LUN FREE_LUN, LUN IF (STRPOS(sname,'SEC2') GE 0) THEN BEGIN WIDGET_CONTROL,mdiag,SET_VALUE='%%DONE CREATING SUMMARY FILE: ../OUT/'+sc+'/SUMMARY/'+sname PRINT,'%%DONE CREATING SUMMARY FILE: ../OUT/'+sc+'/SUMMARY/'+sname ENDIF ENDIF ELSE BEGIN print,'' PRINT,ttime PRINT,tit print,title ;print, str_arr_all(inds) print, str_arr_all ENDELSE END