PROGRAM READFITS
C----------------------------------------------------------------------
C   This VAX FORTRAN-77 program reads the header of a FITS file and
C   extracts text files which were packed into the header by 
C   PACKFITS. Input is taken from the logical file INFIL, and output
C   is written to filenames specified by the value fields of TEXTFILE
C   cards. Unit 3 is used as a scratch file.
C   DCW, 07Jan82.
C----------------------------------------------------------------------
      CHARACTER      B*2880, CARD*80, KEY*8, VAL*72, OUTNAM*30
      LOGICAL        COPY
C
C
      OPEN (UNIT=1, FILE='INFIL', STATUS='OLD', READONLY)
      OPEN (UNIT=3, STATUS='NEW', ACCESS='SEQUENTIAL',
     *      FORM='FORMATTED', CARRIAGECONTROL='NONE',
     *      DISPOSE='DELETE')
      NF = 1
      COPY = .FALSE.
C                                       Read until END is seen:
 10   CONTINUE
         READ (1, 1010, END=90) B
         DO 40 K = 1, 36
            K1 = (K - 1) * 80 + 1
            CARD = B(K1:K1+79)
            KEY = CARD(1:8)
            VAL = CARD(11:80)
C
            IF (KEY.EQ.'END') GO TO 60
C                                       Watch for 'TEXTFILE':
            IF (KEY.NE.'TEXTFILE') GO TO 20
               IF (COPY) CLOSE (UNIT=2)
C                                       List-directed read for value:
               REWIND 3
               WRITE (3, 1015) VAL
               REWIND 3
               READ (3, *) OUTNAM
               OPEN (UNIT=2, FILE=OUTNAM, STATUS='NEW',
     *               ACCESS='SEQUENTIAL', FORM='FORMATTED',
     *               RECORDTYPE='FIXED',
     *               RECL=72, CARRIAGECONTROL='LIST')
               TYPE *, 'Copying to file:', OUTNAM
               COPY = .TRUE.
               GO TO 30
 20         CONTINUE
               IF (COPY) WRITE (2, 1020) CARD(9:80)
 30         CONTINUE
C
 40         CONTINUE
         GO TO 10
C
 60   CONTINUE
      IF (COPY) CLOSE (UNIT=2)
      COPY = .FALSE.
C                                       Skip binary & special records:
 70   CONTINUE
         READ (1, 1010, END=80) 
         GO TO 70
C                                       Tapemark was seen:
 80   CONTINUE
      TYPE *, 'FITS file', NF, ' has been processed.'
      NF = NF + 1
      GO TO 10
C
 90   CONTINUE
      TYPE *, 'Double tapemark = EOI.'
      STOP
C----------------------------------------------------------------------
 1010 FORMAT (A2880)
 1015 FORMAT (A72)
 1020 FORMAT (A72)
      END