;catalog programs
 !redim_warn_flag=0
 ;test program to read new style sequence catalogs
block list
 catname=''
 text=''
 !redim_warn_flag=0
 read,'enter name of CCD catalog file to go through (sans directory)',catname
 ;catname='/data0/lplogs'+catname
 catname='/hosts/diapason/usr2/lplogs/'+catname
 openr,2,catname
 
 ;loop over all the entries
 while (1) do {  readf,2,text
 t,'entry line is:'
 t,text
 s=''    read,'hit return display entry',s
 $id_ccd=text(60:72)
 #t=text
 run $load
 run $show
 }       ;end of while do loop for reading cat file
 close,2
 endblock        ;list
 ;==============================================================================
subr look,tapeid
 ;looks for the tapeid in the default sequence master catalog
 ;runs top level blocks to extract catalog information, the block variables
 ;are not accessible in this code but are accessible to other top level blocks
 ;
 ;decode tape and file number to allow binary search (requires that things
 ;be in proper order)
 tid=upcase(tapeid)	i=strpos(tid,'F')	fn=tid(i+1:*)
 tn=tid(2:i-1)
 tn=fix(tn)	fn=fix(fn)
 ;catname='/data0/lplogs/lp92da.cat'
 catname='/hosts/diapason/usr2/lplogs/lp92da.cat'
 text=''
 openr,2,catname+'size'		;some info on the top catalog file
 s=''	readf,2,s	s=bmap(s)		
	 width=fix(smap(s(2:7))) 	lines=fix(smap(s(10:15))
 close,2
 openr,2,catname
 r=assoc(2,bytarr(width))
 ;now do a binary search on the tape and file number
 low = 0		high = lines-1
 while ( low le high) {
 mid = (low+high)/2
 text=smap(r(mid))
 ;get tape number for this line
 tid=upcase(text(0:9))	i=strpos(tid,'F')
 tnmid=fix(tid(2:i-1))
 if tn lt tnmid then high = mid -1 else { if tn gt tnmid then low = mid + 1 else
 { 		;t,'found the tape #'
 fnmid=fix(tid(i+1:*))
 while (fnmid ne fn) {
   if fnmid gt fn then inc = -1 else inc = 1
				 ;go backwards or forward until we get it 
				 ;or discover it isn't there
     while (1) {	mid += inc	text=smap(r(mid))
      tid=upcase(text(0:9))	i=strpos(tid,'F')
      tnmid=fix(tid(2:i-1))	fnmid=fix(tid(i+1:*))
      if (tnmid ne tn) then { ty,'found tape but not file'  close,2 return }
      if fnmid eq fn then break
     }
 }
 ;must have it
	 $id_ccd=text(60:72)
	 #t=text
	 ty,text
	 run $load
	 run $show
 ;allow browsing at this point
	 ty,'enter a + to see next data set, - to see previous'
	 ty,'anything else to exit'
	 repeat {
	   s=''	read,s		mess=0
	   if s eq '+' then mess = 1  else  if s eq '-' then mess = -1 else
		 break
	   mid += mess
	   text=smap(r(mid))		
	   $id_ccd=text(60:72)
	   #t=text
	   ty,text
	   run $load
	   run $show
	 } until mess eq 0
	 close,2		return  }
 }}      ;end of while do loop for reading cat file
 t,'entry not found in catalog'
 close,2
 endsubr ;look
 ;==============================================================================
subr catload,tapeid
 ;looks for the tapeid in the default sequence master catalog
 ;runs top level blocks to extract catalog information, the block variables
 ;are not accessible in this code but are accessible to other top level blocks
 if symclass(tapeid) ne 2 then { t,'ERROR - catload argument must be a string'
		 retall }
 ;decode tape and file number to allow binary search (requires that things
 ;be in proper order)
 tid=upcase(tapeid)	i=strpos(tid,'F')	fn=tid(i+1:*)
 tn=tid(2:i-1)
 tn=fix(tn)	fn=fix(fn)
 ;catname='/data0/lplogs/lp92da.cat'
 catname='/hosts/diapason/usr2/lplogs/lp92da.cat'
 text=''
 openr,2,catname+'size'		;some info on the top catalog file
 s=''	readf,2,s	s=bmap(s)		
	 width=fix(smap(s(2:7))) 	lines=fix(smap(s(10:15))
 ty, 'width, lines', width, lines
 close,2
 openr,2,catname
 r=assoc(2,bytarr(width))
 ;now do a binary search on the tape and file number
 low = 0		high = lines-1
 while ( low le high) {
 mid = (low+high)/2
 text=smap(r(mid))
 ;get tape number for this line
 tid=upcase(text(0:9))	i=strpos(tid,'F')
 tnmid=fix(tid(2:i-1))
 if tn lt tnmid then high = mid -1 else { if tn gt tnmid then low = mid + 1 else
 { 		;t,'found the tape #'
 fnmid=fix(tid(i+1:*))
 while (fnmid ne fn) {
   if fnmid gt fn then inc = -1 else inc = 1
				 ;go backwards or forward until we get it 
				 ;or discover it isn't there
     while (1) {	mid += inc	text=smap(r(mid))
      tid=upcase(text(0:9))	i=strpos(tid,'F')
      tnmid=fix(tid(2:i-1))	fnmid=fix(tid(i+1:*))
      if (tnmid ne tn) then { ty,'found tape but not file'  close,2 return }
      if fnmid eq fn then break
     }
 }
 ;must have it
	 $id_ccd=text(60:72)
	 #t=text
	 ty,text
	 ty,'ok 1'
	 run $allload
	 ty,'ok 2'
	 close,2
	 return  }
 }}       ;end of while do loop for reading cat file
 t,'entry not found in catalog'
 close,2
 endsubr ;look
 ;==============================================================================
block $load
 bigend=bigendian()
 save=!redim_warn_flag		!redim_warn_flag=0
 ;name='/data0/lplogs/'+$id_ccd+'.ccd_log'
 name='/hosts/diapason/usr2/lplogs/'+$id_ccd+'.ccd_log'
 openr,1,name
 r=assoc(1,intarr(256))
 ;read the first block
 b=r(0)
 sb=b	if bigend then swapb,b 
 nimage=wmap(b(0))
 nexp=wmap(b(1))
 year=wmap(b(2))
 doyy=wmap(b(3))
 tapeid=smap(sb(4))
 if b(5) gt 0 then ss=istring(b(5),4,2) else ss='?'   tapeid=tapeid+ss
 if b(6) gt 0 then ss=istring(b(6),4,2) else ss='?'   tapeid=tapeid+'F'+ss
 bq=bmap(b(7))
 sumx=bq(0)	sumy=bq(1)	
 nx=b(8)		ny=b(9)
 ccdx=b(10)	ccdy=b(11)
 datatype=b(12)
 seqname=smap(sb(13:20))
 arn=b(21)
 longitude=lmap(b(22:23))
 z=reverse(bmap(longitude)) longitude=float(lmap(z)/10.^3)
 lat=lmap(b(24:25))
 z=reverse(bmap(lat)) lat=float(lmap(z)/10.^3)
 pixscale=lmap(b(28:29))
 z=reverse(bmap(pixscale)) pixscale=float(lmap(z)/10.^3)
 if nexp gt 0 then {
 ;figure out how many blocks to read
 nbexp=(nexp+63)/64
 r=assoc(1,bytarr(512))
 b=bytarr(512*nbexp)	for i=1,nbexp do b( (i-1)*512 )=r(i)
 sb=b	if bigend then swapb,b
 i1=0		i2=i1+2*nexp-1
 seq_wave=wmap(b(i1:i2))		;wavelength of line
 i1=i2+1		i2=i1+2*nexp-1
 seq_off=wmap(b(i1:i2))		;offset from line center in milli-Angstroms
 bb=bmap(sb((4*nexp):*))
 redim,bb,4*nexp
 seq_pol=bytarr(3,nexp)
 i2=3*nexp-1
 seq_pol(0)=bb(0:i2)		;polarization state
 seq_width=bytarr(nexp)
 i1=i2+1		i2=i1+nexp-1
 seq_width(0)=bb(i1:i2)		;wide/narrow state
 }
 close,1
 !redim_warn_flag=save
 endblock
 ;==============================================================================
block $allload
 bigend = bigendian()
 save=!redim_warn_flag		!redim_warn_flag=0
 ;does all that $load does plus reads the image specific fields
 ;name='/data0/lplogs/'+$id_ccd+'.ccd_log'
 name='/hosts/diapason/usr2/lplogs/'+$id_ccd+'.ccd_log'
 openr,1,name
 r=assoc(1,intarr(256))
 ;read the first 2 blocks
 b=r(0)
 sb=b	if bigend then swapb,b 
 nimage=wmap(b(0))
 nframes=nimage		;because we like variety (do we?)
 nexp=wmap(b(1))
 year=wmap(b(2))
 doyy=wmap(b(3))
 tapeid=smap(sb(4))
 if b(5) gt 0 then ss=istring(b(5),4,2) else ss='?'   tapeid=tapeid+ss
 if b(6) gt 0 then ss=istring(b(6),4,2) else ss='?'   tapeid=tapeid+'F'+ss
 bq=bmap(b(7))
 sumx=bq(0)	sumy=bq(1)	
 nx=b(8)		ny=b(9)
 ccdx=b(10)	ccdy=b(11)
 datatype=b(12)
 seqname=smap(sb(13:20))
 arn=b(21)
 longitude=lmap(b(22:23))
 z=reverse(bmap(longitude)) longitude=float(lmap(z)/10.^3)
 lat=lmap(b(24:25))
 z=reverse(bmap(lat)) lat=float(lmap(z)/10.^3)
 pixscale=lmap(b(28:29))
 z=reverse(bmap(pixscale)) pixscale=float(lmap(z)/10.^3)
 if nexp gt 0 then {
 ;figure out how many blocks to read
 nbexp=(nexp+63)/64
 r=assoc(1,bytarr(512))
 b=bytarr(512*nbexp)	for i=1,nbexp do b( (i-1)*512 )=r(i)
 sb=b	if bigend then swapb,b
 i1=0		i2=i1+2*nexp-1
 seq_wave=wmap(b(i1:i2))		;wavelength of line
 i1=i2+1		i2=i1+2*nexp-1
 seq_off=wmap(b(i1:i2))		;offset from line center in milli-Angstroms
 bb=bmap(sb((4*nexp):*))
 redim,bb,4*nexp
 seq_pol=bytarr(3,nexp)
 i2=3*nexp-1
 seq_pol(0)=bb(0:i2)		;polarization state
 seq_width=bytarr(nexp)
 i1=i2+1		i2=i1+nexp-1
 seq_width(0)=bb(i1:i2)		;wide/narrow state
 }
 ;to get the tod and other image specific data, just re-read with the entire
 ;file
 ;size of the catalog in blocks
 nb=(13*nimage+511)/512+2
 if nexp gt 64 then nb=nb+1+(nexp-1)/64
 r=assoc(1,bytarr(512*nb))		;the whole catalog
 b1=r(0)
 sb=b1	if bigend then swapb,b1
 off3=1024
 if nexp gt 64 then off3=off3+512*(nexp-1)/64
 i2=off3+4*nimage-1
 tod=lmap(sb(off3:i2))
 if bigend then swapl,tod
 tod=float(tod/10.^3)
 i1=i2+1		i2=i1+2*nimage-1
 exp_times=wmap(b1(i1:i2))
 i1=i2+1		i2=i1+4*nimage-1
 xint=lmap(sb(i1:i2))
 if bigend then swapl,xint
 xint=float(xint/10.^3)
 i1=i2+1		i2=i1+nimage-1
 ccd_status=bmap(sb(i1:i2))
 i1=i2+1		i2=i1+2*nimage-1
 ccd_temp=wmap(b1(i1:i2))
 close,1
 !redim_warn_flag=save
 endblock
 ;==============================================================================
block $show
 save=!redim_warn_flag		!redim_warn_flag=0
 ;a bit complicated to do mulitple columns of the sequence when necessary
 minlines=9		;# of info lines needed
 if nexp gt 51 then nq= 18*(6+nexp) else nq=18*18*3
 ss=blanks(nq)
 types=bmap('unknown solar   flats   darks   ')
 s=bmap(ss)		redim,s,18,num_elem(s)/18
 if nexp gt 0 then {
 for i=0,nexp-1 do {
 ss=ist((i+1)%100,2)+ist(seq_wave(i),5)+ist(seq_off(i),6)+smap(seq_pol(*,i))+ -
	 ' '+smap(seq_width(i))
 s(0,i+1)=bmap(ss)
 }}
 ss=' # wave  off pol r '
 s(0)=bmap(ss)
 sbuf=blanks(num_elem(ss))
 st=' file:'+name
 s1=' D'+ist(doyy,3,1)+ist(year,5)
 i1=datatype*8	if i1 lt 0 or i1 gt 32 then i1=0	i2=i1+7
 s2=' type: '+smap(types(i1:i2))
 s3=' tape: '+tapeid
 s4=' nimage='+ist(nimage,7,2)+', nexp ='+ist(nexp,5,2)
 s5=' CCD: '+ist(sumx,3,2)+'x'+ist(sumy,2,2)+', '+ist(nx,4,2)+'x'+ist(ny,4,2)
 s6='     @('+ist(ccdx,4,2)+', '+ist(ccdy,4,2)+')'
 s7=' sequence: '+seqname(0:10)
 if arn ne 0 then s8=' AR '+ist(arn,5,2) else s8=' AR ????'
 if lat ge 0 then s8=s8+' N' else s8=s8+' S'
 s8=s8+ist(abs(lat),2,1)
 if longitude ge 0 then s8=s8+' W' else s8=s8+' E'
 s8=s8+ist(abs(longitude),2,1)
 s9=' scale: '+string(pixscale)+'"/pixel'
 t,st
 ty,'nexp =', nexp
 if nexp le 0 then for i=1,minlines-1 do t,eval('s'+ist(i+1,2,2)) else {
 if nexp le 17 then {
 ;one column case
 nl=(nexp+1)<minlines
 for i=0,nl-1 do {
 ty,'mark 1'
 ty,'s'+ist(i+1,2,2)
 stmp = 's'+ist(i+1,2,2)
 d, stmp
 d, s1
 dump, eval(stmp)
 dump, eval('s'+string(i+1))
 dump, s, i, eval('s'+ist(i+1,2,2))
 ty,'mark 2'
 ty, smap(s(*,i))+'|'+eval('s'+ist(i+1,2,2)) }
 if (nexp+1) gt minlines then for i=nl,nexp do {t,smap(s(*,i))+'|' }
 if minlines gt (nexp+1) then for i=nl,minlines-1 do {
	 t,sbuf+eval('s'+ist(i+1,2,2)	}
 } else { if nexp le 34 then {
 ;two column case
 t,smap(s(*,0))+'|'+smap(s(*,0))+'|'+s1		;top line after file name
 nl=minlines-1	;ok to put out minlines because of padding in s
 for i=1,nl do {  t,smap(s(*,i))+'|'+smap(s(*,i+17))+'|'+eval('s'+ist(i+1,2,2)) }
 if (nexp-17) gt (minlines-1) then {  for i=nl+1,nexp-17 do {
	 t,smap(s(*,i))+'|'+smap(s(*,i+17))+'|' }  nl=nexp-17 }
 if nl lt 17 then for i=nl+1,17 do t,smap(s(*,i))+'|'
 } else {
 ;3 column case
 ;also get cases gt 51 here
 nq=17>(nexp+2)/3
 nq2=2*nq
 t,smap(s(*,0))+'|'+smap(s(*,0))+'|'+smap(s(*,0))+'|'+s1;top line after filename
 nl=minlines-1	;ok to put out minlines because of padding in s
 for i=1,nl do {
 t,smap(s(*,i))+'|'+smap(s(*,i+nq))+'|'+smap(s(*,i+nq2))+'|'+ -
	 eval('s'+ist(i+1,2,2)) }
 if (nexp-nq2) gt (minlines-1) then {  for i=nl+1,nexp-nq2 do {
	 t,smap(s(*,i))+'|'+smap(s(*,i+nq))+'|'+smap(s(*,i+nq2))+'|' }
	 nl=nexp-nq2 }
 if nl lt nq then for i=nl+1,nq do t,smap(s(*,i))+'|'+smap(s(*,i+nq))+'|'
 }}
 }
 dt=3600.*fix(#t(39:40))+60.*fix(#t(42:43))+fix(#t(45:46)
 dt=dt-3600.*fix(#t(27:28))-60.*fix(#t(30:31))-fix(#t(33:34)
 if dt lt 0 then dt=dt+24.*3600.
 hdt=fix(dt/3600.)	r=dt mod 3600.  mdt=fix(r/60.)  sdt=r mod 60.
 s=istring(hdt,2,1)+':'+istring(mdt,2,1)+':'+istring(sdt,2,1)
  ty,'duration = ',s,' rate = ',dt/nimage, -
  ' mean cadence =',nexp*dt/nimage,' nreps = ',nimage/nexp
 !redim_warn_flag=save
 endblock