c 4k*4k ---> 2k*2k
c scale as 2k
c == extract 2048*17/13 square ccd, shrink to 2k.

	character*80 f2,f3,head2(72),cc*1
	real a(2048,2048),b(4096,4096),c(4000,4000)

        iarg=iargc()
	if(iarg.lt.2)then
	  write(*,*)
	  write(*,*)'         ******** 4k*4k ccd -->2k*2k ccd ********'
	  write(*,*)'         scale as 2k, marked at 2nd line of fits_head'
          write(*,*)
          write(*,*)'           s4kto2k input(4k) output(2k) [X] [Y]'
          write(*,*)'                 X,Y is offset, default is 0'
          write(*,*)
          write(*,*)'            jiang zhaoji    2008,11'
          write(*,*)
          write(*,*)
	  stop
	endif
	xx=0.
        if(iarg.gt.2)then
	  call getarg(3,f2)
          read(f2(1:),*)xx
	endif
	yy=0.
        if(iarg.gt.3)then
	  call getarg(3,f2)
          read(f2(1:),*)yy
	endif

	call getarg(1,f2)
	open(1,file=f2,status='old',iostat=i,access='direct',recl=5760)
	if(i.ne.0)stop 'input file not found!'
	read(1,rec=1)head2
	ipos=indexpos(head2,'NAXIS1  ')
	read(head2(ipos)(16:),*)n1
	if(n1.ne.4096.and.n1.ne.4000)stop 'inp_file not a 4k*4k file'
	close(1)
	write(*,*)'size: ',n1
	if(n1.eq.4096)call readfits(f2,b,n1,n1)
	if(n1.eq.4000)call readfits(f2,c,n1,n1)

        s=17./13.6
        s2=n1/2+0.5

	do 10 i=1,2048
	if(i/100*100.eq.i)call dispdot()
        x=s2+(i-1024.5)*s+xx
        ix0=x
	ix1=ix0+1
        wx=x-ix0
	zx=1.-wx
	do 10 j=1,2048
        y=s2+(j-1024.5)*s+yy
        iy0=y
        iy1=iy0+1
        wy=y-iy0
        zy=1.-wy
        x1=zx*zy
        x2=wx*zy
        x3=zx*wy
        x4=wx*wy
        if(n1.eq.4096)a(2049-i,2049-j)=b(ix0,iy0)*x1+b(ix1,iy0)*x2+
     c                   b(ix0,iy1)*x3+b(ix1,iy1)*x4
        if(n1.eq.4000)a(2049-i,2049-j)=c(ix0,iy0)*x1+c(ix1,iy0)*x2+
     c                   c(ix0,iy1)*x3+c(ix1,iy1)*x4
10	continue	

	call getarg(2,f3)
	n1=2048
        call swap4(a,n1*n1*4)
        write(head2(2)(65:74),"('from 4k*4k')")
        write(head2(4)(27:30),"('2048')")
        write(head2(5)(27:30),"('2048')")
        k=indexpos(head2,"INSTRUME")
	head2(k)(22:30)=head2(k)(12:20)
        head2(k)(12:20)=head2(k)(32:40)
	if(xx.ne.0. .or. yy.ne.0.)then
          k=indexpos(head2,"RA      ")
          f2=head2(k)(12:31)
          f2(20:20)=char(0)
          do 15 i=1,19
          if(f2(i:i).eq.':')f2(i:i)=','
15        if(ichar(f2(i:i)).eq.39)f2(i:i)=' '
          read(f2(1:),*,err=30)i,j,x
          ra=i+j/60.+x/3600.
          f2=head2(k+1)(12:31)
          f2(20:20)=char(0)
          cc=' '
          do 20 i=1,19
          if(f2(i:i).eq.'-')cc='-'
          if(f2(i:i).eq.'-')f2(i:i)=' '
          if(f2(i:i).eq.':')f2(i:i)=','
20        if(ichar(f2(i:i)).eq.39)f2(i:i)=' '
          read(f2(1:),*,err=30)i,j,x
          de=i+j/60.+x/3600.
          if(cc.eq.'-')de=-de
c
	  de=de-yy*1.36/3600.
	  ra=ra-xx*1.36/15./3600./cos(de*3.1416/180.)
	  call toms(ra,head2(k)(18:),1)
	  call toms(de,head2(k+1)(19:),0)
30	  continue
	endif
        k=n1*n1*4+5760
        open(1,file=f3,status='unknown',access='direct',recl=k)
	write(1,rec=1)head2,a
	close(1)

	write(*,*)'re coordinating!'
        f2='coord0 '//f3(1:25)//' !'
        call system(f2)
        f2='ch2ds9 '//f3(1:25)//' !'
        call system(f2)
	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