c	Program EXDIRPT		Read the directory for an Exabyte VMG image
c				tape from disk and write a sequential file
c
c	This program reads the indexed Exabyte FITS tape directory file
c	produced by EXDIRRD and produces a sequential ASCII file for
c	viewing by humans.
c
c	The file containing the records is handled as a FORTRAN indexed
c	(ISAM) file.  The primary key is the cumulative image number.
c	The secondary key is the object name.
c
c	The cumulative image number is the number of the image on the tape,
c	starting at 1 (first cluster, first file).  Cluster and file numbers
c	also start at 1.
c
c	The software will handle up to 32767 files per tape (about 7.6 Gbytes)
c	which should be sufficient for the Exabyte tapes.
c
c	The record contains:
c	cumulative image number		integer*4	pos 1:4, key 0
c	cluster number			integer*4	pos 5:8
c	file number in cluster		integer*4	pos 9:12
c	bits per pixel			integer*4	pos 13:16
c	object name			character*8	pos 17:24, key 1
c	type of observation		character*1	pos 25
c	empty space			character*3	pos 26:28
c	number of frames		integer*4	pos 29:32
c	x offset (arcseconds)		integer*4	pos 33:36
c	y offset (arcseconds)		integer*4	pos 37:40
c	Julian date			real*8		pos 41:48
c	pointer to next observation	integer*4	pos 49:52
c	of same type and number of
c	frames	in this cluster
c	(NULL pointer means no more
c	files of this type.)
c
c	History:
c	14 Jan 90	JRV	first release
c	16 Jan 90	JRV	add command line parameter for tape name
c
c	Declarations
	character*80 header(102),string,filnam,fil2,junk,temp
	character*1 space,brack
	data space/' '/,brack/']'/
	character*22 diskfile
	character*4 sub
	character*6 tape
	data tape /'_MUA0:'/
	integer*4 tapeid,result, j
	integer clustart,cluend,filstart,filend, ios
	integer*4 lstr, yy, mm, dd
	Real*8 ldd
	Character*8 tstr
	logical ltype,leot,lname
	data leot/.false./
	parameter (NULL = 0)
	integer*4 bitpix,nax,naxes(10)
	character*256 filenam, file
c		needed for command line arguments
	character*80 argc(20)
	integer com_args, n_args
c
c	Structure for data records
	Structure /DATREC/
		Integer*4 cumnum
		Integer*4 clustnum
		Integer*4 filenum
		Integer*4 bitpix
		Character*8 objnam
		Character*1 typobs
		Character*3 empty
		Integer*4 nframes
		Integer*4 x
		Integer*4 y
		Real*8 jd
		Integer*4 nextobs
	End Structure
c
c	Declare instances of structures
	Record /DATREC/ thisimage
c
c
	type *, 'EXDIRPT	16-Jan-90 version'
	type *, '		Makes sequential directory file'
	type *, '		from binary directory file'
c
c		Process command line
	string = ' '
	n_args = com_args(argc)
	If (n_args .EQ. 1) then
		string = argc(1)
		lstr = index(string,' ') - 1
	Else If (n_args .GT. 1) then
		type *,'Too many arguments'
		stop
	End If
c		Get name of tape
	If (string .EQ. ' ') then
	   Write(*,1350)
1350	   Format('$Enter name of tape: ')
	   Read(*,1351) string
1351	   Format(a80)
	   lstr = index(string,' ') - 1
	   If (lstr .EQ. 0) then
		type *,'Bad tape name'
		stop
	   Endif
	Endif
	Call ZUpper(string)
	filnam = string(1:lstr)//'.TDR'
	fil2 = string(1:lstr)//'.TDA'
	Write(*,1410) filnam
1410	Format(' Binary Directory file name is: ',a40)
	Write(*,1411) fil2
1411	Format(' ASCII directory file will be: ',a40)
c
	type *,'Reading tape directory...'
c		open directory disk file
	Open(unit=3,file=filnam,status='OLD',organization='INDEXED',
     1		access='KEYED',recordtype='VARIABLE',
     2		form='UNFORMATTED',recl=13,
     3		key=(1:4:integer,17:24:character),iostat=ios,err=251)
	goto 252
251	type *, 'Error opening indexed file, iostat = ', ios
	stop
c
252	continue
	Open(unit=4,file=fil2,status='NEW',iostat=ios,err=261)
	goto 262
261	type *, 'Error opening output file, iostat = ', ios
	stop
262	continue
	write(4, 1000)
1000	format('         Exabyte tape file directory')
	Write(4, 1002) filnam
1002	Format('    Directory file name: ',a40)
	Write(4, 1003)
1003	Format(70('-'))
	Write(4, 1004)
1004	Format('  C File  B  Region  T Itg     X    Y         Time')
	Write(4, 1003)
c
c		read records from disk
270	continue
	read(unit=3,err=351) thisimage
	Call Julian(1,yy,mm,ldd,thisimage.jd)
	Call Timestr(ldd,tstr)
	yy = yy - 1900
	dd = ldd
	write(4, 1001) thisimage.clustnum,
     1		thisimage.filenum, thisimage.bitpix,
     2		thisimage.objnam, thisimage.typobs,
     3		thisimage.nframes, thisimage.x,
     4		thisimage.y, mm,dd,yy,tstr
1001	format(i3,i5,i3,1x,a8,1x,a1,i5,i5,i5,2x,
     1		i2.2,'/',i2.2,'/',i2.2,1x,a8)
	goto 270
c
c		Reached end of file
351	Continue
	close(3)
	close(4)
	type *, 'Done.'
	stop
	end
c
c		Convert to/from Julian dates (copied from 11/44 BBSO
c		Fortran library)
	Subroutine Julian(mode, iy, m, d, djul)
	Real*8 d, djul
	Integer mode, iy, m
	Real*8 n,z,sa,a,b,k,e,p,f,d0,sm,y,c
c
	If (mode .EQ. 0) then
c		Convert calendar date to Julian date
	  sm = m
	  y = iy
	  If (sm .LE. 2.5) then
		y = y - 1.0
		sm = sm + 12.0
	  Endif
	  a = dint(y/100.0)
	  b = 2.0 - a + dint(a/4.0)
	  If (y - 1582.0) 139, 130, 140
130	  If (m - 10) 139, 132, 140
132	  If (d .GE. 15.0) GoTo 140
139	  b = 0.0
140	  p = 365.25*y
	  If (y .LT. 0.0) p = p - 0.75
	  djul = dint(p) + dint(30.6001d0*(sm+1.0d0))+d+1720994.5d0+b
	  Return
	Endif
	If (mode .EQ. 1) then
c		Convert Julian date to calendar date
	  n = djul + 0.5
	  z = dint(n)
	  f = dmod(n,1.0d0)
	  a = z
	  If (z .GE. 2299161.0) then
		sa = dint((z - 1867216.25)/36524.25)
		a = z+1+sa-dint(sa/4.0)
	  Endif
	  b = a + 1524.0
	  c = dint((b - 122.1)/365.25)
	  k = dint(365.25 * c)
	  e = dint((b - k)/ 30.6001)
	  d0 = b - k - dint(30.6001 * e) + f
	  sm = e
	  If (e .GE. 13.5) sm = e - 12.0
	  sm = sm - 1.0
	  iy = jidint(c)
	  If (sm .GE. 2.5) iy = c - 1
	  iy = iy - 4715
	  m = sm
	  d = d0
	  Return
	Endif
	End
c
	Subroutine timestr(realday, tstring)
	Real*8 realday
	Character*8 tstring
c
	Integer ihh,imm,iss,idd
	Real*8	dtmp
c
	idd = realday
	dtmp = realday - idd	
	dtmp = 24.0 * dtmp
	ihh = dtmp
	dtmp = dtmp - ihh
	dtmp = 60.0 * dtmp
	imm = dtmp
	dtmp = dtmp - imm
	dtmp = 60.0 * dtmp
	iss = dtmp
	Write(tstring,1000) ihh,imm,iss
1000	Format(i2.2,':',i2.2,':',i2.2)
	Return
	End