C TAPSUB.FOR SUBROUTINES FOR TAPE READER IN RT-FORTRAN (V2.1) C FOR INFORMATION, READ TAPER.HLP C C ************************************************************************ C C WRITTEN BY: ROGER MATUS, DOUGLAS BOHRER C PERSONNEL DEPARTMENT, THE FIRST NATIONAL BANK OF CHICAGO C 1 FIRST NATIONAL PLAZA, 22ND FLOOR C CHICAGO, ILLINOIS 60670 C C DATE: 11-JUN-80 C C ************************************************************************ C SUBROUTINE SKIP(NFILES) C C THIS SUBROUTINE READS THE TAPE, BLOCK-BY-BLOCK, IN A SEARCH FOR TAPE C MARKS. A TAPE MARK IS INDICATED BY NO CHARACTERS READ (ICHAR.EQ.0) C BETWEEN INTER-BLOCK GAPS. C C THE ROUTINE LOOKS NFILES TIMES FOR MARKS. C TWO MARKS IN A ROW COULD INDICATE LOGICAL END OF TAPE. THIS IS C COVERED. IF NOT, WE COULD SPIN TO THE END OF THE REEL. C C C NOTE: NFILES MAY BE -1. THIS DISABLES THE LEOT CHECK AND C SKIPS ONE FILE ONLY. THIS IS USED BY MAIN PROGRAM C TO ALLOW THE USER TO GET OUT OF A LOOP. C C C COMMON, DIMENSION C COMMON IFILE,IDATA DIMENSION IDATA(10200),ANS(1) LOGICAL*1 IDATA,ANS C C IF NO FILES ARE REQUESTED, RETURN C IF (NFILES.EQ.0) GO TO 160 C C LOOP UNTIL MARK IS FOUND C 110 IBLOCK=0 120 CALL EXTMT(1,10200,IDATA,ICHAR) IF (ICHAR.EQ.0) GO TO 130 IBLOCK=IBLOCK+1 130 IF (ICHAR.NE.0) GO TO 120 C C MARK FOUND, TELL USER. C 11 FORMAT (' MARK --',I6,' BLOCKS READ.') WRITE (5,11) IBLOCK NFILES=NFILES-1 IFILE=IFILE+1 C IF NOT IN FIRST BLOCK, AND WE HAVE MORE FILES, GO BACK IF ((IBLOCK.NE.0).AND.(NFILES.GT.0)) GO TO 110 C C IF NO BLOCKS WERE READ, WE BETTER ASK USER IF IT IS LEOT C C NOTE: IF IT IS LEOT, SUBROUTINE LEOT WILL TERMINATE C PROGRAM EXECUTION WITHOUT A RETURN. C IF ((IBLOCK.EQ.0).AND.(NFILES.GE.0)) CALL LEOT C C FINAL CHECK FOR MORE FILES TO READ (NEEDED IF WE RETURN FROM LEOT) C IF (NFILES.GT.0) GO TO 110 160 RETURN END SUBROUTINE LEOT C C IF WE ARE HERE, TWO TAPE MARKS WERE FOUND IN A ROW OR A TAPE MARK WAS C THE FIRST THING FOUND ON THE TAPE. THE USER IS GIVEN THE OPTION TO C KEEP GOING (AND POSSIBLY SPIN THE TAPE UNTIL THE END OF THE REEL). C C NOTE: IF IT IS LEOT, THIS SUBROUTINE WILL REWIND TAPE AND TERMINATE C EXECUTION OF TAPER. C C DIMENISON, COMMON C COMMON IFILE,IDATA DIMENSION IDATA(10200),ANS(1) LOGICAL*1 IDATA,ANS C C TELL USER C 11 FORMAT ('0',5X,'*** WARNING *** POSSIBLE LOGICAL END OF TAPE.') WRITE (5,11) 12 FORMAT (' ') WRITE (5,12) 13 FORMAT ('$READ ON (Y/N)? ') 2 FORMAT (A1) 110 WRITE (5,13) READ (5,2) ANS IF ((ANS(1).NE.'Y').AND.(ANS(1).NE.'N')) GO TO 110 IF (ANS(1).EQ.'Y') GO TO 150 C C WE ARE AT LOT! *********REWIND AND TERMINATE********* C 5 FORMAT (' LEOT LIKELY AFTER FILE',I6,' ...REWINDING TAPE...') IF (IFILE.NE.1) WRITE (5,5) IFILE-2 CALL EXTMT(7) 6 FORMAT ('0START PROGRAM TO READ TAPE AGAIN.') WRITE (5,6) CALL EXIT C ********* C 150 RETURN END SUBROUTINE FORM (IREC,FMT) C C THIS ROUTINE CREATES THE OBJECT TIME FORMAT FOR WRITING FILES TO DISC. C IT ALLOWS FOR RECORDS OF UP TO 1020 CHARACTERS. C IF YOU NEED MORE, EXPAND THIS SECTION. C C DIMENSION C DIMENSION FMT(30) COMMON IFILE,IDATA C C WHAT RECORD SIZE IS WANTED? C 11 FORMAT ('$RECORD SIZE ? ') 110 WRITE (5,11) 12 FORMAT (I5) 120 READ (5,12) IREC IF (IREC.GT.1020) WRITE (5,1) IF (IREC.GT.1020) GO TO 110 IF (IREC.GT.132) WRITE (5,2) C C WHAT ARE THESE FORMATS? C 255 FORMAT('(',I4,'A1)') 510 FORMAT('(255A1,',I4,'A1)') 765 FORMAT('(255A1,255A1,',I4,'A1)') 1020 FORMAT ('(255A1,255A1,255A1,',I4,'A1)') C C AND NOW, LET'S SELECT THE FORMAT FOR US C IF (IREC.LE.255) ENCODE (8,255,FMT) IREC IF ((IREC.GE.256).AND.(IREC.LE.510)) 1 ENCODE (14,510,FMT) IREC-255 IF ((IREC.GE.511).AND.(IREC.LE.765)) 1 ENCODE (20,765,FMT) IREC-510 IF ((IREC.GE.766).AND.(IREC.LE.1020)) 1 ENCODE (26,1020,FMT) IREC-765 IF (IREC.GT.1020) WRITE (5,1) C 1 FORMAT (' RECORD SIZE MAY NOT EXCEED 1020 CHARACTERS.') 2 FORMAT (' *** WARNING *** RECORD SIZE OF MORE THAN 132 MAY', 1' YIELD UNPREDICTABLE RESULTS.') IF (IREC.GT.1020) STOP 'FATAL ERROR IN RECORD SIZE.' C C NOTE: RECORD SIZE IS TESTED HERE SO THAT IT MAY BE CHANGED BY USER. RETURN END