	program listhd
C	print out all the header records in a FITS file

        integer iunit,status,i,htype,nkeys,nmore,block,ios
	character*80 record,fname,lname
        character*30 errtxt
	logical fileout

        status=0
        iunit=15
	print *,'Name of FITS file to read = ?'
	read(*,2000)fname
2000	format(a)

	print *,'Name of output listing file = ?'
	read(*,2000)lname

	if (lname .eq. ' ')then
		fileout=.false.
	else
		fileout=.true.
		open(unit=16,file=lname,status='NEW',iostat=ios)
		if (ios .ne. 0)then
			print *,'error opening output list file'
			go to 999
		end if
	end if

C	open the existing FITS file
        call ftopen(iunit,fname,0,block,status)

C	find out the number of keywords in the header
5	call ftghsp(iunit,nkeys,nmore,status)

	if (fileout)then
	  write(16,*)'**********************************************'
	else
	  print *,'**********************************************'
	end if

C	print out each keyword
	do 10 i=1,nkeys
		call ftgrec(iunit,i,record,status)
		if (fileout)then
			write(16,*)record
		else
			print *,record
		end if
10	continue

C	print an 'end' record
	if (fileout)then
		write(16,*)'END     '
	else
		print *,'END     '
	end if

C	move to next extension and loop back
	call ftmrhd(iunit,1,htype,status)
	if (status .eq. 0)then
		go to 5
	else if (status .eq. 107)then
		if (fileout)then
			write(16,*)'***** END OF FILE *****'
		else
			print *,'***** END OF FILE *****'
		end if
                status=0
	end if

	call ftclos(iunit,status)

        if (status .ne. 0)then
                call ftgerr(status,errtxt)
		if (fileout)then
			write(16,*)'ERROR ',status,': ',errtxt
		else
			print *,'ERROR ',status,': ',errtxt
		end if
        end if

999	continue
        end
