projects / pdp8.git / blame
| Commit | Line | Data |
|---|---|---|
| 81e70d48 PH |
1 | C -+-+-+-+-+ \ e H A E T O C . F T \ e -+-+-+-+-+\r |
| 2 | C\r | |
| 3 | C OPENS THE INPUT UNIT 7, READS THE RECORD HEADER BLOCK OF EACH RECORD\r | |
| 4 | C AND PRINTS A TABLE OF CONTENTS \r | |
| 5 | C\r | |
| 6 | C * UP 25-JAN-83\r | |
| 7 | C * UP 26-OCT-83\r | |
| 8 | C * UP 22-NOV-83\r | |
| 9 | C * UP 06-DEC-84 NOW YOU CAN CHANGE THE TEXT OF THE LABEL\r | |
| 10 | C\r | |
| 11 | SUBROUTINE TOC\r | |
| 12 | INCLUDE HAEBUF.FI\r | |
| 13 | INCLUDE HAETTY.FI\r | |
| 14 | INCLUDE HAEPTI.FI\r | |
| 15 | INTEGER TOASCI\r | |
| 16 | EXTERNAL TOASCI\r | |
| 17 | \fC\r | |
| 18 | REAL REV @ TEMP SAVE FOR REVISION NUMBER\r | |
| 19 | INTEGER I,J,DTASET,HH,MIN,SEK,KANAL\r | |
| 20 | * ,NEWLAB(14)\r | |
| 21 | C\r | |
| 22 | REV=REVSON @ HERE WE SAVE THE REVISION NUMBER\r | |
| 23 | C COMPUTE THE DATA SET TO BE READ NEXT AND STORE INTO NUM7\r | |
| 24 | NUM7=1 @ START WITH RECORD 1\r | |
| 25 | DTASET=0 @ DTASET IS DECREMENTED FOR EACH RECORD READ\r | |
| 26 | C\r | |
| 27 | IF (REC7.EQ.-1) DEFINE FILE 7(MAXREC,85,U,REC7) @ OPEN UNIT 7\r | |
| 28 | UNIT=7 @ ESAM INPUT IS NOW FROM 7\r | |
| 29 | REC7=1 @ AND READ THE FIRST RECORD, THE HEADER\r | |
| 30 | C\r | |
| 31 | C READ THE HEADER BLOCK\r | |
| 32 | C\r | |
| 33 | 10 READ (7'REC7) (RCRD0(I),I=1,85)\r | |
| 34 | COMP=.FALSE. @ NEW DATA SET, NO COMPUTATIONS SO FAR\r | |
| 35 | IF (REDVAL.EQ.6HDLWPD2) GOTO 20 @ TEST FOR EMPTY RECORD\r | |
| 36 | SAMCNT=0 @ RECORD WAS EMPTY, MAKE IT REALLY EMPTY\r | |
| 37 | REVSON=REV @ RESTORE REVISION NUMBER\r | |
| 38 | RETURN\r | |
| 39 | 20 CONTINUE @ RECORD WAS INSERTED\r | |
| 40 | IF (INT(REVSON).NE.INT(REV)) GOTO 30 @ REVISION NUMBER INCOMPATIBILITY - WE DIE\r | |
| 41 | DTASET=DTASET+1 @ DECREMENT THE DATA SET SEARCH COUNTER\r | |
| 42 | SEK=SAMCNT/SAMRAT @ COMPUTE THE TIME OF THIS SAMPLE\r | |
| 43 | MIN=SEK/60\r | |
| 44 | HH=TOASCI(MIN/60) @ TWO CHAR HOURS\r | |
| 45 | MIN=TOASCI(MOD(MIN,60)) @ TWO CHAR MINUTES\r | |
| 46 | SEK=TOASCI(MOD(SEK,60)) @ TWO CHAR SECONDS\r | |
| 47 | I=LASREC-REC7+1 @ COMPUTE THE NUMBER OF BLOCKS FOR THIS RECORD\r | |
| 48 | KANAL=NCOND(CHNLS.GT.1,3HELE,3HL )\r | |
| 49 | WRITE (TTO,3) DTASET,I,CHNLS,KANAL,SAMRAT,PACK,HH,MIN,SEK,\r | |
| 50 | * (LABEL(J),J=1,LABCNT) @ WRITE THE ID OF THE RECORD WANTED\r | |
| 51 | IF (OPTION.EQ.13) GOTO 35 @ TO+ IF YOU WANT TO CHANGE THE LABEL TEXT\r | |
| 52 | IF (OPTION.EQ.12) @ TO* TYPES AND PRINTS\r | |
| 53 | * WRITE (3,3) DTASET,I,CHNLS,KANAL,SAMRAT,PACK,HH,MIN,SEK,\r | |
| 54 | * (LABEL(J),J=1,LABCNT) @ WRITE THE ID OF THE RECORD WANTED\r | |
| 55 | 15 REC7=LASREC+1 @ READ THE NEXT DATA SET\r | |
| 56 | IF (REC7.LE.BLKCNT) GOTO 10 @ TEST IF WE REACHED THE END OF INFORMATION\r | |
| 57 | C END OF FILE REACHED, RETURN\r | |
| 58 | WRITE (TTO,1) REC7,BLKCNT,DTASET @ WRITE AN ERROR MSG\r | |
| 59 | SAMCNT=0 @ NOTHING READ!\r | |
| 60 | REVSON=REV @ RESTORE REVISION NUMBER\r | |
| 61 | RETURN\r | |
| 62 | 30 CONTINUE\r | |
| 63 | WRITE (TTO,4) REVSON,REV\r | |
| 64 | STOP\r | |
| 65 | C\r | |
| 66 | C\r | |
| 67 | 35 CONTINUE @ HERE WE CHANGE THE TEXT OF THE LABEL\r | |
| 68 | WRITE (TT0,5)\r | |
| 69 | READ (TTI,6) NEWLAB\r | |
| 70 | DO 36 I=1,10\r | |
| 71 | J=11-I @ TO MAKE A DECREMENTING COUNTER\r | |
| 72 | IF (NEWLAB(J).NE.1H ) GOTO 37\r | |
| 73 | 36 CONTINUE\r | |
| 74 | GOTO 15 @ NOTHING CHANGED, KEEP THE OLD NAME\r | |
| 75 | 37 LABCNT=J @ NEW LENGTH OF THE LABEL\r | |
| 76 | REC7=REC7-1 @ AND NOW WE OUTPUT THE NEW LABEL\r | |
| 77 | CALL MOVE (LABCNT,NEWLAB,LABEL)\r | |
| 78 | WRITE (7'REC7) (RCRD0(I),I=1,85)\r | |
| 79 | GOTO 15\r | |
| 80 | C\r | |
| 81 | C\r | |
| 82 | 1 FORMAT (' MIT BLOCK',I5,' ENDE DER DATEI 7',\r | |
| 83 | * ' MIT',I5,' BLOECKEN UND ',I3,' DATENSAETZEN ERREICHT.')\r | |
| 84 | 3 FORMAT (I4,'.',I5,' BLOECKE,',I2,' KANA',A3,', MESSRATE',I3,\r | |
| 85 | * ' HZ.',1X,7I1,/10X,2(A2,1H:),A2,3X,13A6)\r | |
| 86 | 4 FORMAT (' DATENSATZ MIT VERSION ',F3.1,' NICHT VON PROGRAMM'\r | |
| 87 | * ,' MIT VERSION ',F3.1,' ZU VERARBEITEN.')\r | |
| 88 | 5 FORMAT (' NEUE KENNUNG: ',$)\r | |
| 89 | 6 FORMAT (14A6)\r | |
| 90 | END\r | |
| 91 | \1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0 |