PROGRAM PACKFITS
C----------------------------------------------------------------------
C   This VAX FORTRAN-77 program reads formatted files and writes them 
C   to a formatted output file as FITS header cards, with the first 72 
C   characters of each input line shifted right 8 columns. The names 
C   of files to be processed are read from input using a list-directed 
C   read. If no input is provided a single file will be processed
C   with the logical name of INFIL. The logical name of the blocked 
C   FITS output is OUTFIL. FORTRAN unit 2 is used as a scratch file.
C   DCW, 07Jan82.
C----------------------------------------------------------------------
      CHARACTER      ORIGIN*8, INNAM*30, LINE*80, B*2880
      LOGICAL        BLANK
C
C
      INNAM = 'INFIL'
      OPEN (UNIT=2, STATUS='NEW', ACCESS='SEQUENTIAL',
     *      FORM='FORMATTED', CARRIAGECONTROL='NONE',
     *      RECL=80, DISPOSE='DELETE')
      ORIGIN = 'NRAO-CV'
      WRITE (2, 1005) ORIGIN
C                                       Get next input file:
 10   CONTINUE
         READ (5, *, END=40) INNAM
         OPEN (UNIT=1, NAME=INNAM, STATUS='OLD', READONLY)
         WRITE (2, 1010) INNAM
         BLANK = .TRUE.
C                                       Loop to copy the cards:
 20      CONTINUE
            READ (1, 1020, END=30) LINE
            WRITE (2, 1025) LINE(1:72)
            IF (LINE(73:80).NE.'  ') BLANK = .FALSE.
            GO TO 20
C                                       Go back to get next file:
 30      CONTINUE
         CLOSE (UNIT=1)
         IF (.NOT.BLANK) TYPE *, 'Col.73-80 were not blank!'
         TYPE *, 'Finished with file: ', INNAM
         GO TO 10
C                                       No more files, reformat output:
 40   CONTINUE
      WRITE (2, 1040)
      REWIND 2
      OPEN (UNIT=3, FILE='OUTFIL', STATUS='NEW', 
     *      ACCESS='SEQUENTIAL', FORM='FORMATTED',
     *      CARRIAGECONTROL='NONE', RECL=2880)
      B = '  '
      K1 = 0
C                                       Loop to produce FITS blocks:
 50   CONTINUE
         DO 60 K = 1, 36
            READ (2, 1020, END=70) LINE
            K1 = (K - 1) * 80 + 1
            B(K1:K1+79) = LINE
 60         CONTINUE
         WRITE (3, 1060) B
         B = '  '
         K1 = 0
         GO TO 50
C                                       Write last incomplete block:
 70   CONTINUE
      IF (K1.GT.0) WRITE (3, 1060) B
      ENDFILE 3
      CLOSE (UNIT=3)
      CLOSE (UNIT=2)
      STOP
C----------------------------------------------------------------------
 1005 FORMAT ('SIMPLE  =                    T / ',
     *                  'Text file written by PACKFITS.',
     */,      'BITPIX  =                    8 /',
     */,      'NAXIS   =                    0 /',
     */,      'ORIGIN  = ''', A8, '''           /'
     *)
 1010 FORMAT ('TEXTFILE= ''', A30, ''' /')
 1020 FORMAT (A80)
 1025 FORMAT (8X, A72)
 1040 FORMAT ('END')
 1060 FORMAT (A2880)
      END