	byte a(2048*2048*4+2880)
	integer*2 b(512*512)
	character*60 f1
	logical logi
	write(*,*)
	write(*,*)'           ******** DISplay Fits *********** 2000.7'
	write(*,*)' '
	write(*,*)'               if(irat<0) no frame & title'
	write(*,*)
	if(iargc().ne.0)then
	  call getarg(1,f1)
	  goto 10
	endif
20	write(*,'(a,$)')'Input *.fits_names: '
	read(*,'(a)')f1
10	k=index(f1,'.')
	if(k.eq.0)f1=f1(1:lnblnk(f1))//'.fits'
	inquire(file=f1,exist=logi)
	if(.not.logi)then
	  write(*,*)' file not found !'
	  goto 20
	endif
	call readata(f1,a,b,n1,n2)
	call dis(f1,b,n1,n2)
	end
	
	subroutine readata(f1,a,b,n1,n2)
	byte c(2880),a(1),b(1)
	character*60 f1,ch*2880,bb*1
	equivalence (c,ch)

	nn=2880
	is=0
	open(3,file=f1,status='old',access='direct',recl=nn)	
	read(3,rec=1)ch
	k=index(ch,'BITPIX')+26
	read(ch(k:),'(i4)')ibit
        if(ibit.lt.0)ibit=-ibit
	k=index(ch,'NAXIS1')+26
	read(ch(k:),'(i4)')n1
	k=index(ch,'NAXIS2')+26
	read(ch(k:),'(i4)')n2
	k=index(ch,'BSCALE  =')
	if(k.ne.0) read(ch(k+15:),*)bscale
	k=index(ch,'BZERO   =')
	if(k.ne.0) read(ch(k+15:),*)bzero
	if(k.ne.0)then
	 write(*,*)ibit,bscale,bzero
	 write(*,*)' Do you use BSCALE & BZERO ? [n]'
	 read(*,'(a)')bb
	 if(bb.eq.'y'.or.bb.eq.'Y')is=1
	endif
	n=1
55	k=index(ch,'END    ')
	if(k.eq.0)then
	n=n+1
	read(3,rec=n)ch
	goto 55
	endif
	ibit=ibit/8
		write(*,*)n1,n2,ibit
	i=0
	do 60 k=n+1,n+(n1*n2*ibit-1)/nn+1
	read(3,rec=k,err=61)ch
	do 60 j=1,nn
	i=i+1
60	a(i)=c(j)
61	close (3)
	        write(*,*)' *'
        if(ibit.eq.2) call swap2(a,n1*n2*2)
        if(ibit.eq.4) call swap4(a,n1*n2*4)
	if(n1*n2.gt.512*512)then
	  if(ibit.eq.2)call shrink2(a,n1,n2,b)
	  if(ibit.eq.4)call shrink4(a,n1,n2,b)
c	  call turnx2(a,n1,n2,-360)
	        write(*,*)' **'
	  return
	endif
	if(ibit.eq.2)then
	  if(is.eq.1)call ch21(a,b,n1,n2,bscale,bzero)
	  if(is.eq.0)call ch20(a,b,n1,n2) 
	endif
	if(ibit.eq.4)then
	  write(*,*)' factor: (1.) '
	  read(*,*)y
	  if(is.eq.1)call ch41(a,b,n1,n2,bscale*y,bzero)
	  if(is.eq.0)call ch40(a,b,n1,n2,y)
	endif
	return
	end

	subroutine shrink2(a,n1,n2,b)
	integer*2 a(n1,n2)
	integer*2 b(512*512)
	k=0
	m=2
	if(n1.gt.1024.or.n2.gt.1024)m=4
	do 10 j=1,n2,m
	do 10 i=1,n1,m
	k=k+1
	y=0.
	do 20 i1=0,m-1
	do 20 j1=0,m-1
20	y=y+a(i+i1,j+j1)
10	b(k)=nint(y/(m*m))
	n1=n1/m
	n2=n2/m
	end

	subroutine shrink4(a,n1,n2,b)
	real a(n1,n2)
	integer*2 b(512*512)
	k=0
	m=2
	if(n1.gt.1024.or.n2.gt.1024)m=4
	do 10 j=1,n2,m
	do 10 i=1,n1,m
	k=k+1
	y=0.
	do 20 i1=0,m-1
	do 20 j1=0,m-1
20	y=y+a(i+i1,j+j1)
	i1=nint(y/(m*m))
	if(i1.gt.32767)i1=32767
	if(i1.lt.-32767)i1=-32767
10	b(k)=i1
	n1=n1/m
	n2=n2/m
	end

	subroutine ch41(a,b,n1,n2,bscale,bzero)
	real a(n1*n2)
	integer*2 b(n1*n2)
	do 10 i=1,n1*n2
	k=nint(a(i)*bscale+bzero)
	if(k.lt.-32767.)k=-32767
	if(k.gt. 32767.)k= 32767
10	b(i)=k
	end

	subroutine ch40(a,b,n1,n2,y)
	real a(n1*n2)
	integer*2 b(n1*n2)
	do 10 i=1,n1*n2
	k=nint(a(i)*y)
	if(k.lt.-32767.)k=-32767
	if(k.gt. 32767.)k= 32767
10	b(i)=k
	end

	subroutine ch21(a,b,n1,n2,bscale,bzero)
	integer*2 a(n1*n2),b(n1*n2)
	do 10 i=1,n1*n2
10	b(i)=nint(a(i)*bscale+bzero)
	end

	subroutine ch20(a,b,n1,n2)
	integer*2 a(n1*n2),b(n1*n2)
	do 10 i=1,n1*n2
10	b(i)=a(i)
	end

	subroutine dis(f1,map,n1,n2)
	integer*2 map(n1*n2)
	character*60 f1
	character*16 c2,a*80
	i1=-32768
	i2= 32767
	x=0.
	do 10 i=1,n1*n2
	x=x+map(i)
	if(map(i).gt.i1)i1=map(i)
10	if(map(i).lt.i2)i2=map(i)
	x=x/n1/n2
	write(*,1)n1,n2,i1,i2,x
1	format(9x,'Pixel size:',i4,' *',i4,7x,'Max,Min:',2i6,3x,'Mean',f9.1)
	if(i2.ge.0)call whitexblack(map,n1,n2,white,sigma)
	black=white+20.*sigma
11	write(*,*)'white,black,rat(1/2)',white,black,', 1 or 2 (q exit)'
	read(*,'(a)')a
	if(a(1:1).eq.'q'.or.a(1:1).eq.'Q')goto 13
	if(a(1:1).ne.' ')read(a(1:),*,err=11)white,black,irat
	if(c2(1:2).eq.'XW')goto 12
	call pgbegin(0,'?',1,1 )
	call pgpap(8.5,1.)
	call pgqinf('TYPE',c2,k)
	k=irat
	if(irat.lt.0)irat=-irat
	if(irat.gt.2)irat=2
	if(irat.lt.1)irat=1
	if(k.lt.1)call pgsci(0)
	if(c2(1:2).eq.'HP')call pgslw(2)
	call pgenv(1.,float(n1),1.,float(n2),1,-1)
	call pgsci(1)
	if(k.gt.0)call pglabel(' ',' ',f1)
12	call pgxgray(map,n1,n2,1,n1,1,n2,white,black,irat)
	if(c2(1:2).eq.'XW')goto 11
	if(k.gt.0)call pgiden
13	call pgend
	end
