pro pr_gsn, infil, array, outfil=outfil, summary=summary, hc=hc, append=append, $ tapefile=tapefile, qstop=qstop, gsn_head=gsn_head, comments=comments, $ debug=debug debug=keyword_set(debug) or get_logenv('gsn_debug') ne '' lun = -1 if (keyword_set(hc)) then begin qdelete = 1-keyword_set(outfil) outfil = concat_dir(getenv('HOME'), 'pr_gsn.temporary') end if (keyword_set(outfil)) then begin if (keyword_set(append)) then openu, lun, outfil, /get_lun, /append else openw, lun, outfil, /get_lun end qarray = n_params() ge 2 if (keyword_set(gsn_head)) then begin head = gsn_head end else begin if (keyword_set(summary)) then rd_gsn, infil, head $ ;dont read the OBS else rd_gsn, infil, head, obs, imap, fmap, hmap end ; if (keyword_set(tapefile)) then begin ss = -1 for itapefile=0,n_elements(tapefile)-1 do begin if (data_type(tapefile) eq 7) then begin break_file, infil, dsk_log, dir0, filnam sfilnam=strmid(strlowcase(strtrim(filnam,2)),0,9) itape = where(sfilnam eq $ strlowcase(strmid(tapefile(itapefile), 1, 9))) help,filnam,itape ifile = strmid(tapefile(itapefile), 16, 3) ss0 = where((fmap eq itape(0)) and (imap-1 eq ifile)) if ss0(0) eq -1 and debug then stop,'ss0' end else begin ss0 = where(imap eq tapefile(itapefile)) end if (ss0(0) ne -1) then ss = [ss, ss0] end if (n_elements(ss) eq 1) then begin print, 'No File #', tapefile, ' in tape: ', infil print, 'Returning xxx...' return end obs = obs(ss(1:*)) imap = imap(ss(1:*)) hmap = hmap(ss(1:*)) end ; ; 2-DEC-93 22:00:10 8.7 S26E09 512x512 6.4x 6.4 VOL1DIPS 4 0 tit = " Date Time Trans Helio nx,ny FOV (') Tape File# Image# ; if (keyword_set(summary)) then begin ; VOL1DIPS 2 60 HB 512x512 6.5x 6.3 7624A S00W00 0.0 1-DEC-93 18:02:05 to 1-DEC-93 20:00:05 tit = " Tape File# #Images Type nx,ny FOV (') Obj Helio Dev(') First Date/Time Last Date/Time end ; if (not qarray) then begin printf, lun, 'PR_GSN Program run: ', !stime if (n_elements(infil) ne 0) then printf, lun, 'Input File(s): ', infil for i=0,n_elements(comments)-1 do printf, lun, comments(i) printf, lun, ' ' printf, lun, tit printf, lun, ' ' end else begin if (keyword_set(summary)) then array = strarr(n_elements(head)) $ else array = strarr(n_elements(obs)) end iarray = 0 ; if (keyword_set(summary)) then begin for i=0,n_elements(head)-1 do begin pp0 = head(i) if (abs(pp0.pix_siz(0)) gt 10000) then pp0.pix_siz = 5.0*1000 ;PATCH image_types = string(pp0.image_types) + ' ' nx = pp0.image_shape(0) ny = pp0.image_shape(0) xfov = (nx * (pp0.pix_siz(0)/1000.))/60. ;convert to arcmin yfov = (ny * (pp0.pix_siz(1)/1000.))/60. tape = string(pp0.st$tape_name) + ' ' obj = string(pp0.st$object) sttim = fmt_tim(pp0) entim = fmt_tim(anytim2ints(pp0, off=float(pp0.duration))) hel = conv_a2h(pp0.location/10., pp0, /str) if (xfov gt 30) then hel = 'Full.D' del = pp0.location_del/10./60. ; fmt1 = '(1x, a12, 1x, i5, 1x, i5)' fmt2 = '(1x, a5, (i3,"x",i3), 2x, (f4.1, "x", f4.1), 2x, a8, 2x, a, f6.2)' fmt3 = '(1x, a, " to ", a)' str1 = string(tape, pp0.file_num, pp0.n_images, format=fmt1) str2 = string(image_types, nx, ny, xfov, yfov, obj, hel, del, format=fmt2) str3 = string(sttim, entim, format=fmt3) ; if (qarray) then array(iarray) = str1+str2+str3 $ else printf, lun, str1+str2+str3 iarray = iarray + 1 end endif else begin obs0 = obs pp0 = head(hmap-1) bigss=where(pp0.pix_siz(0) gt 10000,bcnt) if bcnt gt 0 then pp0(bigss).pix_siz = 5.0*1000 nx = pp0.image_shape(0) ny = pp0.image_shape(0) xfov = (nx * (pp0.pix_siz(0)/1000.))/60. ;convert to arcmin yfov = (ny * (pp0.pix_siz(1)/1000.))/60. tape = string(pp0.st$tape_name) + ' ' hel = conv_a2h(obs0.location/10., obs0, /str) fullss = where(xfov gt 30,fcnt) if fcnt gt 0 then hel(fullss)='Full.D' ; fmt1 = '(1x, a, 1x, f4.1, 2x, a)' fmt2 = '(1x, (i3,"x",i3), 2x, (f4.1, "x", f4.1))' fmt3 = '(1x, a12, 1x, i3, 1x, i3)' str1 = fstring(fmt_tim(obs0),format='(a)') + ' ' + $ fstring(obs0.tranpar/255.*10, format='(f4.1)') + ' ' + $ fstring(hel, format='(a)') str2 = fstring(nx, format='(i3,"x")') + $ fstring(ny, format='(i3)') + ' ' + $ fstring(xfov, format='(f4.1,"x")') + $ fstring(yfov, format='(f4.1)') str3 = fstring(tape, format='(a12)') + ' ' + $ fstring(pp0.file_num, format='(i3)') + ' ' + $ fstring(obs0.image_num, format='(i3)') array=' ' + str1+' ' + str2 + ' ' + str3 if 1-qarray then printf, lun, array, format='(a)' endelse ; if (lun ne -1) then begin flush,lun on_ioerror,again free_lun, lun goto,ok again: free_lun, lun ok: endif if (keyword_set(hc)) then dprint, outfil, /land if (keyword_set(qdelete)) then file_delete, outfil if (keyword_set(qstop)) then stop end