sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haetoc.ft

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