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