	character*60 f1
	character*80 head(72)
	integer ix(9),iy(9)
	real a(2048,2048),b(2048,2048)
	data ix/1,684,1366,1,684,1366,1,684,1366/
	data iy/1,1,1,684,684,684,1366,1366,1366/

	if(iargc().lt.1)then
	  write(*,*)
	  write(*,*)'         Usage:  j_writefits9 file'
	  write(*,*)
	  write(*,*)'                        2009.12'
	  write(*,*)
	  stop
	endif

	call getarg(1,f1)
	n1=2048
	k=index(f1,'.')
        if(k.eq.0)f1=f1(1:lnblnk(f1))//'.fits'

	k=index(f1,'.')-1
	do 10 m=1,9
	jx=ix(m)
	jy=iy(m)
	f1=f1(1:k)//char(m+48)//'.fits'//char(0)
	write(*,*)f1(1:k+5),jx,'-',jx+682,'   ',jy,'-',jy+682
	call gethead(f1,head)
	call readfits(f1,b,n1,n1)
	do 10 j=jy,jy+682
	do 10 i=jx,jx+682
10	a(i,j)=b(i,j)
	call swap4(a,2048*2048*4)
	f1=f1(1:k)//'.fits'//char(0)
        call writefits(f1,head,80*72,1)
        call writefits(f1,a,n1*n1*4,0)
        end

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