C -+-+-+-+-+  H A E T O C . F T  -+-+-+-+-+ C C OPENS THE INPUT UNIT 7, READS THE RECORD HEADER BLOCK OF EACH RECORD C AND PRINTS A TABLE OF CONTENTS C C * UP 25-JAN-83 C * UP 26-OCT-83 C * UP 22-NOV-83 C * UP 06-DEC-84 NOW YOU CAN CHANGE THE TEXT OF THE LABEL C SUBROUTINE TOC INCLUDE HAEBUF.FI INCLUDE HAETTY.FI INCLUDE HAEPTI.FI INTEGER TOASCI EXTERNAL TOASCI C REAL REV @ TEMP SAVE FOR REVISION NUMBER INTEGER I,J,DTASET,HH,MIN,SEK,KANAL * ,NEWLAB(14) C REV=REVSON @ HERE WE SAVE THE REVISION NUMBER C COMPUTE THE DATA SET TO BE READ NEXT AND STORE INTO NUM7 NUM7=1 @ START WITH RECORD 1 DTASET=0 @ DTASET IS DECREMENTED FOR EACH RECORD READ C IF (REC7.EQ.-1) DEFINE FILE 7(MAXREC,85,U,REC7) @ OPEN UNIT 7 UNIT=7 @ ESAM INPUT IS NOW FROM 7 REC7=1 @ AND READ THE FIRST RECORD, THE HEADER C C READ THE HEADER BLOCK C 10 READ (7'REC7) (RCRD0(I),I=1,85) COMP=.FALSE. @ NEW DATA SET, NO COMPUTATIONS SO FAR IF (REDVAL.EQ.6HDLWPD2) GOTO 20 @ TEST FOR EMPTY RECORD SAMCNT=0 @ RECORD WAS EMPTY, MAKE IT REALLY EMPTY REVSON=REV @ RESTORE REVISION NUMBER RETURN 20 CONTINUE @ RECORD WAS INSERTED IF (INT(REVSON).NE.INT(REV)) GOTO 30 @ REVISION NUMBER INCOMPATIBILITY - WE DIE DTASET=DTASET+1 @ DECREMENT THE DATA SET SEARCH COUNTER SEK=SAMCNT/SAMRAT @ COMPUTE THE TIME OF THIS SAMPLE MIN=SEK/60 HH=TOASCI(MIN/60) @ TWO CHAR HOURS MIN=TOASCI(MOD(MIN,60)) @ TWO CHAR MINUTES SEK=TOASCI(MOD(SEK,60)) @ TWO CHAR SECONDS I=LASREC-REC7+1 @ COMPUTE THE NUMBER OF BLOCKS FOR THIS RECORD KANAL=NCOND(CHNLS.GT.1,3HELE,3HL ) WRITE (TTO,3) DTASET,I,CHNLS,KANAL,SAMRAT,PACK,HH,MIN,SEK, * (LABEL(J),J=1,LABCNT) @ WRITE THE ID OF THE RECORD WANTED IF (OPTION.EQ.13) GOTO 35 @ TO+ IF YOU WANT TO CHANGE THE LABEL TEXT IF (OPTION.EQ.12) @ TO* TYPES AND PRINTS * WRITE (3,3) DTASET,I,CHNLS,KANAL,SAMRAT,PACK,HH,MIN,SEK, * (LABEL(J),J=1,LABCNT) @ WRITE THE ID OF THE RECORD WANTED 15 REC7=LASREC+1 @ READ THE NEXT DATA SET IF (REC7.LE.BLKCNT) GOTO 10 @ TEST IF WE REACHED THE END OF INFORMATION C END OF FILE REACHED, RETURN WRITE (TTO,1) REC7,BLKCNT,DTASET @ WRITE AN ERROR MSG SAMCNT=0 @ NOTHING READ! REVSON=REV @ RESTORE REVISION NUMBER RETURN 30 CONTINUE WRITE (TTO,4) REVSON,REV STOP C C 35 CONTINUE @ HERE WE CHANGE THE TEXT OF THE LABEL WRITE (TT0,5) READ (TTI,6) NEWLAB DO 36 I=1,10 J=11-I @ TO MAKE A DECREMENTING COUNTER IF (NEWLAB(J).NE.1H ) GOTO 37 36 CONTINUE GOTO 15 @ NOTHING CHANGED, KEEP THE OLD NAME 37 LABCNT=J @ NEW LENGTH OF THE LABEL REC7=REC7-1 @ AND NOW WE OUTPUT THE NEW LABEL CALL MOVE (LABCNT,NEWLAB,LABEL) WRITE (7'REC7) (RCRD0(I),I=1,85) GOTO 15 C C 1 FORMAT (' MIT BLOCK',I5,' ENDE DER DATEI 7', * ' MIT',I5,' BLOECKEN UND ',I3,' DATENSAETZEN ERREICHT.') 3 FORMAT (I4,'.',I5,' BLOECKE,',I2,' KANA',A3,', MESSRATE',I3, * ' HZ.',1X,7I1,/10X,2(A2,1H:),A2,3X,13A6) 4 FORMAT (' DATENSATZ MIT VERSION ',F3.1,' NICHT VON PROGRAMM' * ,' MIT VERSION ',F3.1,' ZU VERARBEITEN.') 5 FORMAT (' NEUE KENNUNG: ',$) 6 FORMAT (14A6) END