ccccc f77 read_img.f -o read_img.e -fno-second-underscore -L/star/lib `cfitsio_link`

       program img_read
       implicit none
       integer status,inunit,outunit,readwrite,blocksize,morekeys,
     >hdutype
      character infilename*300,outfilename*300,argc*300,filename*300,
     : stemfile*300,bounds(5)*5,ext*5,basefile*300,keyname*8
       character*80 card,fitsargs(6)
       integer l,i,j,ext_no,lx,hx,ly,hy,numargs,ios,nhdu,hdunum,
     >keylength,hdtype
       status=0
       ios=0
     
       numargs = iargc()
       write (6,*) numargs 
        call getarg(1,argc)
        read(argc,'(a)',IOSTAT=ios) filename
        call getarg(2,argc)
        read(argc,'(a)',IOSTAT=ios) outfilename
        write (6,*) 'ios= ',ios
        call getarg(3,argc)
        read(argc,*,IOSTAT=ios) ext_no 
        write (6,*) 'ios= ',ios       
        call getarg(4,argc)
        read(argc,*,IOSTAT=ios) lx   
        write (6,*) 'ios= ',ios     
        call getarg(5,argc)
        read(argc,*,IOSTAT=ios) hx  
        write (6,*) 'ios= ',ios      
        call getarg(6,argc)
        read(argc,*,IOSTAT=ios) ly   
        write (6,*) 'ios= ',ios     
        call getarg(7,argc)
        read(argc,*,IOSTAT=ios) hy 
        write (6,*) 'ios= ',ios
        if (ios .ne. 0) then
        write (6,*) '__ERROR__ with input values'
        stop
        end if
        if (numargs > 7) then
        call getarg(8,argc)   
        read(argc,'(a)',IOSTAT=ios) fitsargs(1)
        call getarg(9,argc)  
        read(argc,'(a)',IOSTAT=ios) fitsargs(2)
        call getarg(10,argc)   
        read(argc,'(a)',IOSTAT=ios) fitsargs(3)
        call getarg(11,argc)   
        read(argc,'(a)',IOSTAT=ios) fitsargs(4)
        call getarg(12,argc)   
        read(argc,'(a)',IOSTAT=ios) fitsargs(5)
        call getarg(13,argc)   
        read(argc,'(a)',IOSTAT=ios) fitsargs(6)
        do i=1,numargs-7
        write (6,*) fitsargs(i)
        end do

        end if
        write (6,*) 'ios= ',ios
 7      continue
 10     format(i5.5)
        write(ext,10) ext_no
        write(bounds(1),10) lx
        write(bounds(2),10) hx
        write(bounds(3),10) ly
        write(bounds(4),10) hy
        call deletespace(filename,l)
 
        infilename=filename(1:l)//
     :'['//ext//']['//
     :bounds(1)//':'//bounds(2)//','//
     :bounds(3)//':'//bounds(4)//']'


   
ccccc      outfilename='BTESTFILEZ.FITS.gz'
      write (6,*)infilename
C  Delete the file if it already exists, so we can then recreate it
C  The deletefile subroutine is listed at the end of this file.
      call deletefile(outfilename,status)

C  Get  unused Logical Unit Numbers to use to open the FITS files.
      call ftgiou(inunit,status)
      call ftgiou(outunit,status)
      call ftnopn(inunit,filename,readwrite,status)
      call ftinit(outunit,outfilename,blocksize,status)
      call ftthdu(inunit,hdunum,status)
      write (6,*) 'hdus ',hdunum
      if (hdunum .gt. 1 .and. ext_no .gt. 0) then
      morekeys=0
      call ftcopy(inunit,outunit,morekeys,status) 
      call ftcrhd(outunit,status)     
      end if
      call ftclos(inunit, status)
 
C  Open the input FITS file, with readonly access
      readwrite=0
      call ftnopn(inunit,infilename,readwrite,status)
      write (6,*) status
C  Create the new empty FITS file (value of blocksize is ignored)
      blocksize=1
 

C  FTCOPY copies the current HDU from the input FITS file to the output
C  file.  The MOREKEY parameter allows one to reserve space for additional
C  header keywords when the HDU is created.   FITSIO will automatically
C  insert more header space if required, so programmers do not have to
C  reserve space ahead of time, although it is more efficient to do so if
C  it is known that more keywords will be appended to the header.
      morekeys=1
      call ftcopy(inunit,outunit,morekeys,status)
      card='EXTNAME = ''WSAIMAGE''    '
      call FTIREC(outunit,8,card, status)
      write (6,*) 'status now ',status


      do i=1,numargs-7
      call FTGTHD(fitsargs(i),card,hdtype,status)
      call FTGKNM(card,keyname,keylength,status)
      write (6,*) card,status
      call FTMCRD(outunit,keyname,card,status)
      status=0
      end do
 

      

      call ftclos(inunit, status)
      call ftclos(outunit, status)
      call ftfiou(-1, status)
      write (6,*) 'final status  ',status
C  Check for any error, and if so print out error messages.
C  The PRINTERROR subroutine is listed near the end of this file.
c      if (status .gt. 0)call printerror(status)
      end


C====================================================================
      SUBROUTINE DELETESPACE(STRIN,LSTR)
C====================================================================
C     DELETES ALL SPACES OF A STRING
C
C     STRIN ..... STRING WHERE SPACES ARE REMOVED
C
C     LSTR ...... LENGTH OF STRING
C--------------------------------------------------------------------
      CHARACTER *(*) STRIN
      CHARACTER *256 STRI1
      INTEGER LSTR,I,L,J
C--------------------------------------------------------------------
C
      L=LEN(STRIN)
      LSTR=0
      J=0
C
      IF (L.EQ.0) GOTO 9999
C
      DO I=1,L
         IF (STRIN(I:I).NE.' ') THEN
            J=J+1
            STRI1(J:J)=STRIN(I:I)
         END IF
      END DO
C
      LSTR=J
      STRIN=STRI1(1:J)
C
 9999 CONTINUE
C
      RETURN
C
      END

      subroutine deletefile(filename,status)

C  A simple little routine to delete a FITS file

      integer status,unit,blocksize
      character*(*) filename

C  Simply return if status is greater than zero
      if (status .gt. 0)return

C  Get an unused Logical Unit Number to use to open the FITS file
      call ftgiou(unit,status)

C  Try to open the file, to see if it exists
      call ftopen(unit,filename,1,blocksize,status)

      if (status .eq. 0)then
C         file was opened;  so now delete it 
          call ftdelt(unit,status)
      else if (status .eq. 103)then
C         file doesn't exist, so just reset status to zero and clear errors
          status=0
          call ftcmsg
      else
C         there was some other error opening the file; delete the file anyway
          status=0
          call ftcmsg
          call ftdelt(unit,status)
      end if

C  Free the unit number for later reuse
      call ftfiou(unit, status)
      end
