SIMPLE = T / Text file written by PACKFITS. BITPIX = 8 / NAXIS = 0 / ORIGIN = 'NRAO-CV ' / TEXTFILE= 'fits4.rno ' / .ps 60,71 .sp 1 .autoparagraph .autosubtitle .flag substitute .date .c;The FITS Test Tape, Version 4 .title The FITS Test Tape .s 4 .c;Donald C. Wells .c;National Radio Astronomy Observatory .c;Edgemont Road .c;Charlottesville, VA 22901 .c;(804) 296-0211, FTS 538-1271 .s 1 .c;$$date .s 4 .c;Abstract The contents of Version 4 of the FITS Test Tape are described. Various implementation details are discussed, as well as the differences of style which are seen in the files on the tape. .s 4 .subtitle Introduction .hl1 Introduction It is difficult to describe a communication protocol like FITS in a manner which is unambiguous for all people who read the written version of the specifications. The same words can mean significantly different things to different people. Indeed, a protocol standard document must be made to read almost like a legal contract in order to try to reduce ambiguities to a minimum. FITS must be implemented in real computer systems, and the vendors of computer systems differ in their interpretation of the meaning of various words used to describe computer hardware and software. It is easy to imagine that differences in interpretation of the FITS documents or of implementation of computer systems by vendors might make various FITS implementations differ in subtle ways, and users of astronomical data systems might be frustrated occasionally by incompatibilities as they carry their data from system to system. The purpose of the Test Tape is to provide a sample set of files which are believed to be in conformance with the FITS specifications and which can be used to 'certify' that FITS reading programs function correctly. These samples of the FITS format are intended to eliminate any residual uncertainties which may exist about the precise meaning of the specifications. The Test Tape itself must be certified. Its certification is the responsibility of the whole community of FITS users. Errors or problems must be reported if the test tape scheme is to work. The author promises to accept such reports graciously. The author also invites suggestions for improvements in the content, style, etc., of the Test Tape. It is especially important that the rigor of the tests made by the tape should be affirmed by many sites. The present tape includes files which were written by six different systems at four different observatories. Such diversity tends to insure against error. The author will welcome tapes of samples of the output style of additional systems for inclusion in future versions of the tape. The astronomical data processing community can be thankful that there have been almost no reports of incompatibility problems with FITS, but it would be foolish to be complacent. The best insurance against incompatibilities is provided by systematic trials of data exchange which are designed to assure that a certain minimum set of the features of the FITS design are implemented consistently at all sites and in all systems. The Test Tape is the most important component of this process. If a site has a program which can read the FITS Test Tape correctly it can use this program to certify the correctness of any FITS writing program which it has, although ultimately this assurance is not as convincing as the knowledge that one or more other systems with independent implementations read the output files correctly. The implementors of FITS reading and writing programs should always be on guard against incompatibilities. Whenever errors are discovered in implementations at other sites they should be privately reported to those sites in a polite manner so that they may be eliminated. If this is not done the errors will propagate farther and farther, and the whole community will suffer. The FITS specifications must not be regarded as being absolutely complete or frozen. It is particularly important that any ambiguities which may exist in the original specifications of FITS should be discussed publicly. Common errors of interpretation must be discussed, and differences of style which are permissable within the specifications of the design must be examined to determine whether they imply that the specifications should be modified or extended. Extensions of the specifications to cover applications which were not considered by the original designers are certain to be needed in the long run. The IAU Circular provides a forum for all such discussions. They are also an appropriate subject for the AAS Working Group for Astronomical Software, and for the analogous European group. TEXTFILE= 'packfits.for ' / 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 TEXTFILE= 'readfits.for ' / 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 TEXTFILE= 'copyfits.for ' / PROGRAM COPYFITS C---------------------------------------------------------------------- C This VAX FORTRAN-77 program does selective copying of FITS-like C files {i.e., 2880-byte records}. It reads simple integers using a C FORTRAN-77 list-directed read statement in order to control its C action. Possible values and corresponding actions are: C C +n = copy n files from input to output. C 0 = rewind input. C -n = skip n files on input. C C Notes: C 1. In order to make a selective copy successive integers can be C given all on the same input line. For example, the input line C 5 -1 3 -2 9999 / C will cause the copying of the first five files, skipping the 6th C file, copying the next 3 files, skipping two, and then copying C the rest of the file to the double filemark. The slash is C mandatory because it terminates the list-directed read C operation. After completing specified operations the program C returns to read another input line. End-of-Information on input C {CTRL_Z on the terminal keyboard} stops the program. C 2. The program will read another input line immediately upon C encountering a double tapemark in either the skip or copy modes. C If an entire FITS tape is to be copied without regard for the C actual number of files on the tape one can simply specify a C copy operation of an enormous number of files (e.g., 9999 / ), C and let the double tapemark rule halt the process. Note: C After a double tapemark is seen on a tape the next operation C should be 0 {rewind} because the results of any read operation C at this point will probably be unpredictable. C 3. If an enormous skip operation (e.g., -9999 / ) is specified the C overall effect is print the number of files in the input C and the number of records in each file. In such a case the C output is never opened and so it need not even exist! C 4. The immediate rewind option (copy/skip value of 0) enables C file copies to be made with file order changed. In order to get C this action use skip and copy commands to copy some files, C then rewind, and do a different set of skip and copy commands to C copy the rest of the files. E.g., use an input line like: C -3 2 0 3 -2 999 / C The input files will be copied to the output in the C order 4 5 1 2 3 6 7 ... by this command. C 5. COPYFITS is able to do tape-to-tape, tape-to-disk, disk-to-tape, C and disk-to-disk copies. The input is called INFIL, C and the output (if there is one) is called OUTFIL. Disk file C names can be ASSIGNed to these logical names. COPYFITS uses the C SYS$TRNLOG System Service to get the actual names of these C logical names, and then it examines the beginning of the name C strings to determine whether the devices are disk or tape. C The RECORDTYPE is 'FIXED' for tape and 'VARIABLE' for disk C in order that ENDFILE statements and END indications will work C correctly. C 6. Remember to do rewind operations to assure tape position! C Foreign tapes are not automatically rewound at any time! C DCW, 04Jan82. C---------------------------------------------------------------------- C INTEGER*2 KC, NF, NF2, NR, NCOPY, NC(30), ICOPY, LC INTEGER*4 STATUS, SYS$TRNLOG, SS$_NORMAL, SS$_NOTRAN CHARACTER B*2880, TEXT*21, DEVTYP*4 CHARACTER INNAM*63, INCLS*4 CHARACTER OUTNAM*63, OUTCLS*4 LOGICAL COPY, D2OPEN C DATA SS$_NORMAL /1/, SS$_NOTRAN /'00000629'X/ C C Is input tape, or disk? STATUS = SYS$TRNLOG ('INFIL', LC, INNAM, , , ) IF (STATUS.EQ.SS$_NORMAL) GO TO 1 IF (STATUS.EQ.SS$_NOTRAN) TYPE *, 'INFIL not ASSIGNed!' IF (STATUS.NE.SS$_NOTRAN) TYPE *, * 'Unexpected STATUS returned by SYS$TRNLOG! STATUS=', STATUS GO TO 999 1 CONTINUE DEVTYP = INNAM(1:2) IF (DEVTYP(1:1).EQ.'_') DEVTYP = INNAM(2:3) INCLS = 'DISK' C MF = TU78; C MM = 6250 bpi drives @ NRAO; C MS = TS-11; C MT = TE16, TU45, or TU77: IF ((DEVTYP.EQ.'MF') .OR. (DEVTYP.EQ.'MM') .OR. (DEVTYP.EQ.'MS') * .OR. (DEVTYP.EQ.'MT')) INCLS = 'TAPE' TYPE *, 'INFIL=', ''''//INNAM(1:LC)//''',', 'Device_Class=',INCLS IF (INCLS.EQ.'DISK') OPEN (UNIT=1, FILE=INNAM, * STATUS='OLD', READONLY) IF (INCLS.EQ.'TAPE') OPEN (UNIT=1, FILE=INNAM, * STATUS='OLD', READONLY, * ACCESS='SEQUENTIAL', FORM='FORMATTED', * RECORDTYPE='FIXED', RECL=2880, BUFFERCOUNT=2) C D2OPEN = .FALSE. OUTCLS = '????' NF = 0 NF2 = 0 C Read next input line: 5 CONTINUE DO 7 I = 1, 30 NC(I) = -32109 7 CONTINUE TYPE *, 'Enter integer(s) terminated by slash:' READ (UNIT=5, FMT=*, END=90) NC C Loop over list of integers: DO 60 KC = 1, 30 NCOPY = NC(KC) IF (NCOPY.EQ.-32109) GO TO 70 TYPE *, 'NCOPY(', KC, ')=', NCOPY C IF (NCOPY.NE.0) GO TO 10 REWIND 1 TYPE *, 'Input file has been rewound.' NF = 0 GO TO 60 C 10 CONTINUE COPY = (NCOPY.GT.0) NCOPY = IABS (NCOPY) C Loop to copy files: DO 50 ICOPY = 1, NCOPY C NR= 0 C IF (.NOT.COPY) GO TO 15 IF (OUTCLS.NE.'????') GO TO 12 C Is output tape, or disk? STATUS = SYS$TRNLOG ('OUTFIL', LC, OUTNAM, , , ) IF (STATUS.EQ.SS$_NORMAL) GO TO 11 IF (STATUS.EQ.SS$_NOTRAN) TYPE *, 'OUTFIL not ASSIGNed!' IF (STATUS.NE.SS$_NOTRAN) TYPE *, * 'Unexpected STATUS returned by SYS$TRNLOG! STATUS=', * STATUS GO TO 999 11 CONTINUE DEVTYP = OUTNAM(1:2) IF (DEVTYP(1:1).EQ.'_') DEVTYP = OUTNAM(2:3) OUTCLS = 'DISK' C MF = TU78; C MM = 6250 bpi drives @ NRAO; C MS = TS-11; C MT = TE16, TU45, or TU77: IF ((DEVTYP.EQ.'MF') .OR. (DEVTYP.EQ.'MM') .OR. * (DEVTYP.EQ.'MS') .OR. (DEVTYP.EQ.'MT')) OUTCLS = 'TAPE' TYPE *, 'OUTFIL=', ''''//OUTNAM(1:LC)//''',', * 'Device_Class=', OUTCLS IF (OUTNAM.EQ.INNAM) TYPE *, 'Note: OUTFIL.EQ.INFIL !!' 12 CONTINUE IF (OUTCLS.NE.'DISK') GO TO 13 IF (D2OPEN) GO TO 15 OPEN (UNIT=2, FILE=OUTNAM, STATUS='NEW', * ACCESS='SEQUENTIAL', FORM='FORMATTED', * CARRIAGECONTROL='NONE', RECL=2880) D2OPEN = .TRUE. GO TO 15 13 CONTINUE IF (OUTCLS.NE.'TAPE') STOP 'Bad OUTCLS!' OPEN (UNIT=2, FILE=OUTNAM, STATUS='NEW', * ACCESS='SEQUENTIAL', FORM='FORMATTED', * CARRIAGECONTROL='NONE', * RECORDTYPE='FIXED', RECL=2880, BUFFERCOUNT=2) 15 CONTINUE C Loop to copy records in a file: 20 CONTINUE READ (1, 1020, END=30) B IF (COPY) WRITE (2, 1020 ) B NR = NR + 1 GO TO 20 C Here to copy a tapemark: 30 CONTINUE IF (COPY .AND. (OUTCLS.EQ.'TAPE')) CLOSE (UNIT=2) IF (COPY .AND. (OUTCLS.EQ.'DISK')) ENDFILE 2 NF = NF + 1 IF (COPY) NF2 = NF2 + 1 TEXT = ' seen after' IF (COPY) TEXT = ' copied after copy of' TYPE *, ' Tapemark number', NF, TEXT, * NR, ' records. NF2=', NF2 C Test for double tapemark case: IF (NR.GT.0) GO TO 50 TYPE *, ' That was a double tapemark (end-of-information).' GO TO 70 C 50 CONTINUE 60 CONTINUE 70 CONTINUE GO TO 5 C Exit: 90 CONTINUE CLOSE (UNIT=1) IF (D2OPEN) CLOSE (UNIT=2) IF (NF2.GT.0) TYPE *, NF2, ' files were written to the output.' 999 STOP C---------------------------------------------------------------------- 1020 FORMAT (A2880) END TEXTFILE= 'compfits.for ' / PROGRAM COMPFITS C---------------------------------------------------------------------- C This VAX FORTRAN-77 program compares FITS-like files to assure that C they are identical. It uses the SYS$TRNLOG service in the same C way that COPYFITS does in order to be able to read either tape C or disk. It rewinds both inputs and then does a comparison of both C their structure and their contents. It types out informative C messages about the structure as it proceeds. The input logical C names are INFIL1 and INFIL2. C DCW, 04Jan82. C---------------------------------------------------------------------- C INTEGER*4 NF, NR, NT INTEGER*4 STATUS, SYS$TRNLOG, SS$_NORMAL, SS$_NOTRAN CHARACTER INNAM1*63, INCLS1*4, B1*2880, DEVTYP*4 CHARACTER INNAM2*63, INCLS2*4, B2*2880 C DATA SS$_NORMAL /1/, SS$_NOTRAN /'00000629'X/ C C Is input1 tape, or disk? STATUS = SYS$TRNLOG ('INFIL1', LC, INNAM1, , , ) IF (STATUS.EQ.SS$_NORMAL) GO TO 1 IF (STATUS.EQ.SS$_NOTRAN) TYPE *, 'INFIL1 not ASSIGNed!' IF (STATUS.NE.SS$_NOTRAN) TYPE *, * 'Unexpected STATUS returned by SYS$TRNLOG! STATUS=', STATUS GO TO 999 1 CONTINUE DEVTYP = INNAM1(1:2) IF (DEVTYP(1:1).EQ.'_') DEVTYP = INNAM1(2:3) INCLS1 = 'DISK' C MF = TU78; C MM = 6250 bpi drives @ NRAO; C MS = TS-11; C MT = TE16, TU45, or TU77: IF ((DEVTYP.EQ.'MF') .OR. (DEVTYP.EQ.'MM') .OR. (DEVTYP.EQ.'MS') * .OR. (DEVTYP.EQ.'MT')) INCLS1 = 'TAPE' TYPE *, 'INFIL1=', ''''//INNAM1(1:LC)//''',', * 'Device_Class=',INCLS1 IF (INCLS1.EQ.'DISK') OPEN (UNIT=1, FILE=INNAM1, * STATUS='OLD', READONLY) IF (INCLS1.EQ.'TAPE') OPEN (UNIT=1, FILE=INNAM1, * STATUS='OLD', READONLY, * ACCESS='SEQUENTIAL', FORM='FORMATTED', * RECORDTYPE='FIXED', RECL=2880, BUFFERCOUNT=2) C C Is input2 tape, or disk? STATUS = SYS$TRNLOG ('INFIL2', LC, INNAM2, , , ) IF (STATUS.EQ.SS$_NORMAL) GO TO 2 IF (STATUS.EQ.SS$_NOTRAN) TYPE *, 'INFIL2 not ASSIGNed!' IF (STATUS.NE.SS$_NOTRAN) TYPE *, * 'Unexpected STATUS returned by SYS$TRNLOG! STATUS=', STATUS GO TO 999 2 CONTINUE DEVTYP = INNAM2(1:2) IF (DEVTYP(1:1).EQ.'_') DEVTYP = INNAM2(2:3) INCLS2 = 'DISK' C MF = TU78; C MM = 6250 bpi drives @ NRAO; C MS = TS-11; C MT = TE16, TU45, or TU77: IF ((DEVTYP.EQ.'MF') .OR. (DEVTYP.EQ.'MM') .OR. (DEVTYP.EQ.'MS') * .OR. (DEVTYP.EQ.'MT')) INCLS2 = 'TAPE' TYPE *, 'INFIL2=', ''''//INNAM2(1:LC)//''',', * 'Device_Class=',INCLS2 IF (INCLS2.EQ.'DISK') OPEN (UNIT=2, FILE=INNAM2, * STATUS='OLD', READONLY) IF (INCLS2.EQ.'TAPE') OPEN (UNIT=2, FILE=INNAM2, * STATUS='OLD', READONLY, * ACCESS='SEQUENTIAL', FORM='FORMATTED', * RECORDTYPE='FIXED', RECL=2880, BUFFERCOUNT=2) C REWIND 1 REWIND 2 NF = 0 NT = 0 C Loop to compare files: 40 CONTINUE NR = 0 C Loop to compare records in a file: 50 CONTINUE READ (1, 1020, END=70) B1 NR = NR + 1 NT = NT + 1 READ (2, 1020, END=80) B2 IF (B1.NE.B2) GO TO 90 GO TO 50 C Assure tapemarks in same position: 70 CONTINUE READ (2, 1020, END=100) B2 TYPE *, ' Tapemark seen on 1 but not seen on 2! NR=', NR STOP 70 C 80 CONTINUE TYPE *, ' Tapemark seen on 2 but not seen on 1! NR=', NR STOP 80 C 90 CONTINUE TYPE *, ' Bad compare in record', NR STOP 90 C Tapemark seen on both tapes: 100 CONTINUE NF = NF + 1 NT = NT + 1 TYPE *, ' Tapemark number', NF, ' seen after', NR, ' records.' C Test for double tapemark: IF (NR.GT.0) GO TO 40 C TYPE *, ' Double tape mark seen. Good compare!' TYPE *, ' Total number of blocks (data+tapemarks) =', NT C CLOSE (UNIT=1) CLOSE (UNIT=2) C 999 STOP C---------------------------------------------------------------------- 1020 FORMAT (A2880) END TEXTFILE= 'listfits.for ' / PROGRAM LISTFITS C---------------------------------------------------------------------- C This VAX FORTRAN-77 program lists the headers of the files of a C FITS tape. It also prints the number of blocks in each file, and C compares the number with the number which can be predicted from C the BITPIX and NAXISn values given in the first header block in C each file. The program terminates on double-tapemark. It uses the C SYS$TRNLOG scheme to permit it to list from either tape or disk. C The logical name of the input is INFIL. The program checks for C proper formatting of the required keywords. C DCW, NRAO-CV, 04Jan82. C---------------------------------------------------------------------- INTEGER*4 STATUS, SYS$TRNLOG, SS$_NORMAL, SS$_NOTRAN INTEGER*4 BITPIX, NAXIS, NAXISN(7), NB, MB, MR LOGICAL*2 HEADER CHARACTER INNAM*63, DEVTYP*4, INCLS*4, BLOCK*2880 CHARACTER SIMPLE*30, NNAXIS*6 C DATA SS$_NORMAL /1/, SS$_NOTRAN /'00000629'X/ C C Is input tape, or disk? STATUS = SYS$TRNLOG ('INFIL', LC, INNAM, , , ) IF (STATUS.EQ.SS$_NORMAL) GO TO 1 IF (STATUS.EQ.SS$_NOTRAN) TYPE *, 'INFIL not ASSIGNed!' IF (STATUS.NE.SS$_NOTRAN) TYPE *, * 'Unexpected STATUS returned by SYS$TRNLOG! STATUS=', STATUS GO TO 999 1 CONTINUE DEVTYP = INNAM(1:2) IF (DEVTYP(1:1).EQ.'_') DEVTYP = INNAM(2:3) INCLS = 'DISK' C MF = TU78; C MM = 6250 bpi drives @ NRAO; C MS = TS-11; C MT = TE16, TU45, or TU77: IF ((DEVTYP.EQ.'MF') .OR. (DEVTYP.EQ.'MM') .OR. (DEVTYP.EQ.'MS') * .OR. (DEVTYP.EQ.'MT')) INCLS = 'TAPE' TYPE *, 'INFIL=', ''''//INNAM(1:LC)//''',', 'Device_Class=',INCLS IF (INCLS.EQ.'DISK') OPEN (UNIT=1, FILE=INNAM, * STATUS='OLD', READONLY) IF (INCLS.EQ.'TAPE') OPEN (UNIT=1, FILE=INNAM, * STATUS='OLD', READONLY, * ACCESS='SEQUENTIAL', FORM='FORMATTED', * RECORDTYPE='FIXED', RECL=2880, BUFFERCOUNT=2) C C REWIND 1 LO = 6 NF = 0 C 10 CONTINUE NF = NF + 1 NR = 0 NH = 0 HEADER = .TRUE. WRITE (LO, 1010) NF WRITE (LO, 1013) ((J, I = 1, 9), J+1, J = 0, 7) WRITE (LO, 1013) ((I, I = 1,9), 0, J = 1,8) WRITE (LO, 1016) C 20 CONTINUE READ (1, 1020, END=100) BLOCK NR = NR + 1 IF (.NOT.HEADER) GO TO 20 NH = NH + 1 C DO 30 K = 1,36 KC = (K - 1) * 80 + 1 WRITE (LO, 1025) NH, K, BLOCK(KC:KC+79) 30 CONTINUE C IF (NR.GT.1) GO TO 70 C Analyze contents of first block: SIMPLE = 'SIMPLE = T' IF (BLOCK(1:30).EQ.SIMPLE) GO TO 40 TYPE *, ' First card of header is not of the form:' WRITE (LO, 1025) 1, 1, SIMPLE TYPE *, ' Therefore, this is not a standard FITS header!' GO TO 70 C Compute number blocks for matrix: 40 CONTINUE IF (BLOCK(81:90).NE.'BITPIX = ') TYPE *, * 'BITPIX keyword defective!' READ (BLOCK, 1040, ERR=70) BITPIX, NAXIS, (NAXISN(I), I=1,NAXIS) NB = BITPIX / 8 IF ((NB.EQ.1) .OR. (NB.EQ.2) .OR. (NB.EQ.4)) GO TO 50 TYPE *, ' Illegal BITPIX:', BITPIX STOP 40 50 CONTINUE IF (BLOCK(161:170).NE.'NAXIS = ') TYPE *, * 'NAXIS keyword defective!' MB = 0 IF (NAXIS.GT.0) MB = NB DO 60 I = 1,NAXIS KC = I * 80 + 161 NNAXIS = 'NAXIS' // CHAR (ICHAR ('0') + I) IF (BLOCK(KC:KC+9).NE.(NNAXIS // ' = ')) TYPE *, * NNAXIS, ' keyword defective!' MB = MB * NAXISN(I) 60 CONTINUE MR = (MB + 2879) / 2880 C Look for END card: 70 CONTINUE DO 80 I = 1, 2880, 80 IF (BLOCK(I:I+7).NE.'END ') GO TO 80 HEADER = .FALSE. GO TO 90 80 CONTINUE 90 CONTINUE C Loop back for next block: GO TO 20 C Here on tapemarks: 100 CONTINUE TYPE *, ' Tapemark number', NF, ' seen.' IF (NR.GT.0) GO TO 110 TYPE *, ' No blocks seen = double-tapemark.' GO TO 999 110 CONTINUE IF (HEADER) TYPE *, ' This header does not contain an END card!' TYPE *, NR, ' data blocks seen:' TYPE *, NH, ' header blocks.' TYPE *, (NR-NH), ' binary blocks.' IF ((NR-NH).LT.MR) TYPE *, ' We expected to see', MR, * ' matrix blocks!' IF ((NR-NH).GT.MR) TYPE *, (NR-NH-MR), * ' of the binary blocks are "special records"!' IF ((NR-NH).EQ.MR) TYPE *, ' No "special records" were seen.' GO TO 10 C 999 CONTINUE TYPE '(''1'')' STOP C---------------------------------------------------------------------- 1010 FORMAT ('1Listing of header of FITS file', I4, ':', /) 1013 FORMAT (' ', 4X, ' ', 2X, ' ', 80I1) 1016 FORMAT (' ', 4X, ' ', 2X, ' ', 80('-')) 1020 FORMAT (A2880) 1025 FORMAT (' ', I4, '/', I2.2, ': ', A80) 1040 FORMAT (80X, 9(10X, I20, 50X)) END TEXTFILE= 'listfits.com ' / $ALLOCATE MMA0: INFIL $MOUNT/NOLABEL/BLO=2880/REC=2880/DEN=1600 INFIL: $RUN DBA0:[DON.FITS]LISTFITS END