real a(2048*2048)
	character*40 f1,f2
	logical logi
	if(iargc().lt.1)then
	write(*,*)
	write(*,*)'  2000.7******* DISplay & PLOT finding chart ********'
	write(*,*)
	write(*,*)'      Usage: dislh file  (ex: dislh par.file)'
	write(*,*)
	write(*,*)'   par.file including following messages:'
	write(*,1)
1	format(
     */'b0630634T521f024_5_8.fit    ! fits file',
     */'b0630634T521f024_5_8.cat    ! position file (from j_xy4ad)',
     */'3                           ! field (arcmin)    3 or 10'
     */'T521                        ! title',
     */'42 48                       ! sub_title column  (start,end)',
     */'25                          ! XY_position column',
     */'2 25                        ! RA.DEC column     (start,end)',
     */'18 2028                     ! x range',
     */'1  2046                     ! y range',
     */'0                           ! 0 display, 1 print')
	stop
	endif
	call getarg(1,f1)
	inquire(file=f1,exist=logi)
	if(.not.logi)then
	  write(*,*)'file not found  ',f1
	  stop
	endif
        open(11,file=f1,status='old')
	read(11,'(a)')f1	
	k= ib_file(f1)
	inquire(file=f1,exist=logi)
	if(.not.logi)then
	  write(*,*)f1,'file not found !'
	  stop
	endif
	read(11,'(a)')f2	
	k= ib_file(f2)

	inquire(file=f2,exist=logi)
	if(.not.logi)then
	  write(*,*)f2,'file not found !'
	  stop
	endif
        read(11,*)id
	write(*,*)f1
	write(*,*)f2
	if(id.lt.5)id=3
	if(id.ge.5)id=10
	write(*,*)'field in arcmin: ',id
	call readfits(f1,a,n1,n2)
	if(id.eq.3)call dis3(f2,a,n1,n2)
	if(id.eq.10)call dis10(f2,a,n1,n2)
	end

	function ib_file(f1)
	character*40 f1
	do 10 i=1,40
	if(f1(i:i).le.' ')goto 20
10	continue
	goto 40
20	do 30 j=i,40
30	f1(i:i)=char(0)
40	ib_file=i-1	
	end	
	
	subroutine dis3(f1,aa,n1,n2)
	real aa(n1,n2)
	integer*2 map(107,107)
	real zx,zy
	character*40 f1,title
	character*70 ds
        read(11,'(a)')title
	read(11,*)ic1,ic2
	read(11,*)ipcol
	read(11,*)ir1,ir2
	read(11,*)kx1,kx2
	read(11,*)ky1,ky2
	read(11,*)ihp
	  it=ib_file(title)
	  write(*,*)title
  	  write(*,*)ic1,ic2
	  write(*,*)ipcol
	  write(*,*)ir1,ir2
	  write(*,*)kx1,kx2
	  write(*,*)ky1,ky2
	  write(*,*)ihp
	close(11)
	n1=107
	n2=107
	open(1,file=f1,status='old')
	do 5 i=1,n1
	do 5 j=1,n2
5	map(i,j)=aa(i+500,j+500)*.25
	call whitexblack(map,n1,n2,white,sigma)
	ipp=0
10	if(ihp.eq.0)call pgbegin(0,'/xw',6,4)
	if(ihp.ne.0)call pgbegin(0,'/lh',6,4)
	ip=0
	do 201 i=1,24
111	read(1,'(a)',end=1201)ds
	read(ds(ipcol:),*,err=111)zx,zy
	ip=ip+1
	i1=nint(zx)
	i2=nint(zy)
	call pgenv(1.,107.,1.,107.,1,-1)
	k1=0
	do 203 j1=i1-53,i1+53
	k2=0
	k1=k1+1
	do 203 j2=i2-53,i2+53
	k2=k2+1
	k=aa(j1,j2)*.25
	if(k.gt.32767)k=32767
	if(k.lt.-32767)k=-32767
203	map(108-k1,k2)=k
	call whitexblack(map,n1,n2,white,sigma)
	black=white+20.*sigma
	call pgxgray(map,n1,n2,1,n1,1,n2,white,black,irat)
	call pgsch(2.)
	call pgtext(1.,-10.,title(1:it)//ds(ic1:ic2))
        call pgtext(1.,112.,ds(ir1:ir2))
        call pgsch(1.)
201	continue
1201	call pgiden

	call pgend

	if(ihp.ne.0)then
        call system("print pgplot.lh")
        write(*,*)ipp,'    return please!'
        read(*,'(a)')ds
	write(*,*)' printing!'
        ipp=ipp+1
	endif
        if(ip.eq.24)goto 10
	close(1)
	end

	subroutine dis10(f1,aa,n1,n2)
	real aa(n1,n2)
	integer*2 map(353,353)
	real zx,zy
	character*40 f1,title
	character*70 ds
        read(11,'(a)')title
	read(11,*)ic1,ic2
	read(11,*)ipcol
	read(11,*)ir1,ir2
	read(11,*)kx1,kx2
	read(11,*)ky1,ky2
	read(11,*)ihp
	  it=ib_file(title)
	  write(*,*)title
  	  write(*,*)ic1,ic2
	  write(*,*)ipcol
	  write(*,*)ir1,ir2
	  write(*,*)kx1,kx2
	  write(*,*)ky1,ky2
	  write(*,*)ihp
	close(11)
	n1=353
	n2=353
	open(1,file=f1,status='old')
	do 5 i=1,n1
	do 5 j=1,n2
5	map(i,j)=aa(i+500,j+500)*.25
	call whitexblack(map,n1,n2,white,sigma)
	ipp=0
10	if(ihp.eq.0)call pgbegin(0,'/xw',4,3)
	if(ihp.ne.0)call pgbegin(0,'/lh',4,3)
	ip=0
	do 201 i=1,12
111	read(1,'(a)',end=1201)ds
	read(ds(ipcol:),*,err=111)zx,zy
	ip=ip+1
	i1=nint(zx)
	i2=nint(zy)
	call pgenv(1.,353.,1.,353.,1,-1)
	k1=0
	do 203 j1=i1-176,i1+176
	k2=0
	k1=k1+1
	do 203 j2=i2-176,i2+176
	k2=k2+1
	k=aa(j1,j2)*.25
	if(k.gt.32767)k=32767
	if(k.lt.-32767)k=-32767
203	map(354-k1,k2)=k
	call whitexblack(map,n1,n2,white,sigma)
	black=white+20.*sigma
	call pgxgray(map,n1,n2,1,n1,1,n2,white,black,irat)
	call pgsch(2.)
	call pgtext(1.,-30.,title(1:it)//ds(ic1:ic2))
        call pgtext(1.,363.,ds(ir1:ir2))
        call pgsch(1.)
201	continue
1201	call pgiden
	call pgend
	if(ihp.ne.0)then
        call system("print pgplot.lh")
        write(*,*)ipp,'    return please!'
        read(*,'(a)')ds
	write(*,*)' printing!'
        ipp=ipp+1
	endif
        if(ip.eq.12)goto 10
	close(1)
	end