        character*40 f1,nf4(55)
	character*12 ac,dc
	character*78 dis
	byte bell
	real*8 a8(8),adcoef(2,3)
	real sx(55),sy(55), pho(55),xw(55)
	character*80 head(72)	
	logical logi
        pi=4.*atan(1.)
        cx=pi/12.
        cy=pi/180.

	if(iargc().lt.1)then
	write(*,*)
	write(*,*)'       ******** DISplay star**********2000.7'
	write(*,*)
	write(*,*)
	write(*,*)' Usage: mo2 list_fit_file'
	write(*,*)
	write(*,*)'             list_fits_files <=25'
	write(*,*)'        small block = 101*101 pixel'
	stop
	endif

	call getarg(1,f1)
	inquire(file=f1,exist=logi)
	if(.not.logi)then
	  write(*,*)f1,'file not found !'
	  stop
	endif

	m4=0
	open(1,file=f1,status='old')
5	m4=m4+1
c	if(m4.eq.26)goto 6
	read(1,'(a)',end=6)nf4(m4)
	inquire(file=nf4(m4),exist=logi)
	if(.not.logi)then
	  write(*,*)nf4(m4),'file not found !'
	  stop
 	endif
        if(m4.eq.1)then
          call gethead(nf4(1),head)               ! mother file
          call geta8(head,a8)
          call xytoad(a8,adcoef)
          x=a8(7)
          y=a8(8)
          sx(1)=0
          sy(1)=0
	  xx=x/cx
	  yy=y/cy
	  call toms(xx,ac,1)
	  call toms(yy,dc,0)
	  write(*,*)' Center  ',ac,dc,'(2000.0)'
          ipos=indexpos(head,'VOLT3   ')
	  read(head(ipos)(25:),*)pho(m4)
        else 
          call gethead(nf4(m4),head)            
          ipos=indexpos(head,'A87     ')
          read(head(ipos)(20:),*)alpha
          read(head(ipos+1)(20:),*)delta
          ipos=indexpos(head,'VOLT3   ')
	  read(head(ipos)(25:),*)pho(m4)
          call standc(x,y,alpha,delta,xi,xn)
          sx(m4)=adcoef(1,1)*xi+adcoef(1,2)*xn+adcoef(1,3)-1024.5
          sy(m4)=adcoef(2,1)*xi+adcoef(2,2)*xn+adcoef(2,3)-1024.5
        endif
	  goto 5
6	  m4=m4-1
	write(*,*)'                                   shift     seeing'
        do 7 i=1,m4
7	write(*,8)i,nf4(i)(1:25),sx(i),sy(i),pho(i)
8	format(i2,':  ',a,2f6.2,f9.2)
	if(m4.gt.25)m4=25

	call pgbegin(0,'/xw',1,1)
	call pgpap(8.5,1.)
	call pgsch(0.8)
	call pgsci(0)
	call pgenv(0.,1.,0.,1.,0,0)
	call pgsci(1)
	epoch=2000.
10      write(*,21)epoch
21	format(' input alpha delta [',f6.1,']')
        read(*,'(a)')dis
	k=1
11	if(dis(k:k).eq.' ')then
	  k=k+1
	  goto 11
	endif
	call itohd(dis(k:),alpha,delta,xx)
	if(xx.ne.0.)epoch=xx
        call astprs(alpha,delta,epoch,alpha,delta,2000.)
        alpha=alpha*cx
	delta=delta*cy
          call standc(x,y,alpha,delta,xi,xn)
          alpha=adcoef(1,1)*xi+adcoef(1,2)*xn+adcoef(1,3)
          delta=adcoef(2,1)*xi+adcoef(2,2)*xn+adcoef(2,3)
	  alpha=2049.-alpha
	  delta=2049.-delta
        j1=30
        j2=30
	do 13 i=1,m4
        i1=alpha+sx(i)+0.5
        i2=delta+sy(i)+0.5
        pho(i)=disp4(nf4(i),i1,i2,j1,j2,xw(i))
        j1=j1+120
	if(j1>530)then
	  j1=30
	  j2=j2+120
	endif
13	continue
 	goto 10
	end	

	function disp4(f1,i1,i2,ix,iy,xw)
	character*40 f1
	integer*2 map(101*101),ma(101*101)
	real xmap(101*101)

	call readcc(f1,xmap,i1,i2)
	ip=0
        do 203 i=1,101*101
	if(xmap(i).le.0.)then
	  map(i)=32767
	else
   	  ip=ip+1
	  j=xmap(i)*.25
	  if(j.gt.32766)j=32766
	  ma(ip)=j
          map(i)=j
	endif
203	continue
	call whitexblack(ma,1,ip,white,sigma)
	if(white.gt.0.)then
	  xw=white
	else
	  white=xw
	endif
	disp4=photo(xmap,white*4.)
        call ximage2(map,101,ix,iy,white*0.95,white+20.*sigma)
	end

	function photo(a,white)
	real a(101,101)
	xx=0
        do 206 j1=-5,+5
        do 206 j2=-5,+5
	k=j1*j1+j2*j2
	if(k.gt.25)goto 206
	x=a(51+j1,51+j2)-white
	if(x.gt.0)xx=xx+x
206	continue
	photo=25.-2.5*alog10(xx)
	end

        subroutine ximage2(map,n,ix,iy,black,white)
        integer*2 map(n,n)
        character dummy
        real rbuf(101*101+2)
        n16=84
        d=n16/(black-white)
        rbuf(1)=ix
        do 40 j=1,n
        rbuf(2)=641-(iy+j)
        i6=2
        do 30 i=1,n
        k=nint(d*(map(i,j)-white))
        if(k.lt.1)k=1
        if(k.gt.n16)k=n16
        i6=i6+1
30      rbuf(i6)=k+15
40      call xwdriv(26,rbuf,i6,dummy)
        call pgebuf
        end

        subroutine gethead(f1,head)
        character*80 head(72),f1*40
        open(52,file=f1,status='old',access='direct',recl=5760)
        read(52,rec=1)head
        close (52)
        end

        subroutine geta8(head,a8)
        real*8 a8(8)
        character*80 head(72)
        ipos=indexpos(head,'A81     ')-1
        do 10 i=1,8
10      read(head(i+ipos)(12:),*)a8(i)
        end

        function indexpos(head,f1)
        character*80 head(72),f1*8
        do 10 indexpos=1,72
10      if(head(indexpos)(1:8).eq.f1)return
        end
