        parameter (m=300000)           ! fits file size
	parameter (cols=  23)          ! cols
	parameter (rows=6000)          ! rows
        byte a(m)
        character*19 name(99)          ! fitss_6 1st colum is a string
        character*8  title(cols)       ! colum's title
        character*12 f1
	integer fits(7,5)              ! fits_number 1--7,col,row,haddr,daddr
	real b(cols,rows)

	write(*,*)
	write(*,*)
        write(*,*)"readout data from fits file (include 7 sub fits)"
	write(*,*)
	write(*,*)

10	write(*,*)" input fits_file name: "
	read(*,*)f1
	call openfits6(f1, a,m,fits, name)
c smaple of output:
	do 5 i=1,7
5	write(*,1)i,(fits(i,j),j=1,5)
1	format("fits_",i1,"     col:",i5,"    row:",i5,"    addr:",3i7)

20	write(*,*)" input fits_num"
	read(*,*)n
	if(n.lt.1.or.n.gt.7)goto 20
	call readfit(n,b,title, a,fits,name, m,cols,rows) 
c smaple of output:
	if(n.ne.1) write(*,*)(title(i),'   ',i=1,fits(n,1))
        if(n.eq.6)then
	  do 60 j=1,fits(n,2)
60	  write(*,*)j,": ",name(j),(b(i,j),i=2,fits(n,1))
	else
	  do 6 j=1,fits(n,2)
6	  write(*,*)j,": ",(b(i,j),i=1,fits(n,1))
	endif
	goto 20
	end

	subroutine readfit(n,b,title,a,fits,name, m,cols,rows)
        byte a(m)
        character*19 name(99)          ! fits_6 1st colum is a string
        character*8  title(cols)       ! colum's title
	integer fits(7,5)              ! fits_number 1--7,col,row,haddr,daddr
	real b(cols,rows)
	character*3  form(88)
	character*19 ename
	byte dname(19)
	equivalence (ename,dname)

	if(n.eq.1)then
	  k=fits(n,4)
	  do 5 i=1,fits(n,1)
	  do 5 j=1,fits(n,2)
	  b(i,j)=fread(a(k))
5	  k=k+4
	  return
	endif
c read title
	k=fits(n,3)
	k=k+jpos(a(k),"TFORM1  ")+10
	do 10 i=1,fits(n,1)
	do 20 j=1,3
20	dname(j)=a(k+j)
        form(i)=ename(1:3)
	k=k+80
	do 30 j=1,8
30	dname(j)=a(k+j)
        title(i)=ename(1:8)
10	k=k+80

c readata
	k=fits(n,4)
	do 50 j=1,fits(n,2)
	do 50 i=1,fits(n,1)
	  if(form(i)(2:2).eq.'E')then
	    b(i,j)=fread(a(k))
	    k=k+4
	  endif
	  if(form(i)(2:2).eq.'J')then
	    b(i,j)=iread(a(k))
	    k=k+4
	  endif
	  if(form(i)(2:2).eq.'A')then
	    b(i,j)=a(k)
	    k=k+1
	  endif
	  if(form(i)(2:2).eq.'9')then
	    do l=1,19
	    dname(l)=a(l+k-1)
	    enddo
	    name(j)=ename
	    k=k+19
	  endif
50	continue
	end
	

	subroutine openfits6(f1,a,m,fits,name)
	character*(*) f1
	character*19 name(99)
	logical logi
	byte a(m)
        integer fits(7,5)
	inquire(file=f1,exist=logi)
	if(.not.logi)then
          write(*,*)f1,'file not found !'
          stop
        endif
        open(1,file=f1,status='old',recl=m)
        read(1,rec=1)a
	close(1)
	k=1
	do 20 i=1,7
        ibitpix=ipos(a(k),"BITPIX  ")
	if(ibitpix.lt.0)ibitpix=-ibitpix	
	fits(i,5)=ipos(a(k),"NAXIS1  ")
	fits(i,2)=ipos(a(k),"NAXIS2  ")
	if(i.ne.1)fits(i,1)=ipos(a(k),"TFIELDS ")
	if(i.eq.1)fits(i,1)=fits(i,5)
	fits(i,3)=k
 	fits(i,4)=iadd(a(k),"END     ")+k        
20	k=(fits(i,4)+fits(i,5)*fits(i,2)*ibitpix/8+2879)/2880*2880+1
	k=fits(1,1)
	fits(1,1)=fits(1,2)
	fits(1,2)=k
        end

	function ipos(a,c)
	byte a(1),c(1),d(10)
	character*15 e
	equivalence (e,d)
	k=0
5	do 10 i=1,8
10	if(a(i+k).ne.c(i))goto 20
	do 30 i=1,10
30	d(i)=a(i+k+20)
	read(e(1:),*)ipos
	return
20	k=k+80
	goto 5
	end

	function iadd(a,c)
	byte a(1),c(1)
	k=0
5	do 10 i=1,8
10	if(a(i+k).ne.c(i))goto 20
	iadd=(k+2879)/2880*2880
	return
20	k=k+80
	goto 5
	end

	function jpos(a,c)
	byte a(1),c(1)
	k=0
5	do 10 i=1,8
10	if(a(i+k).ne.c(i))goto 20
	jpos=k
	return
20	k=k+80
	goto 5
	end

        function fread(a)
        byte a(4),c(4)
        real b
        equivalence (c,b)
        c(1)=a(4)
        c(2)=a(3)
        c(3)=a(2)
        c(4)=a(1)
        fread=b
        end

        function iread(a)
        byte a(4),c(4)
        integer b
        equivalence (c,b)
        c(1)=a(4)
        c(2)=a(3)
        c(3)=a(2)
        c(4)=a(1)
        iread=b
        end
