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

   1 C       -+-+-+-+-+ \ e  H A E S A M . F T  \ e -+-+-+-+-+
   2 C
   3 C       FETCH THE INDEX'ED DATA-WORD FROM "CHANEL" OUT OF THE SAMPLE ON "UNIT"
   4 C       THE FIRST ELEMENT OF THE SAMPLE BUFFER IS REFERENCED WITH INDEX=0
   5 C
   6 C       * UP  7-OCT-82
   7 C       * UP 18-OCT-83 TWO INPUT BUFFERS
   8 C
   9         REAL FUNCTION ESAM(INDEX)
  10         INTEGER INDEX
  11 C
  12         INCLUDE HAEBUF.FI
  13         INCLUDE HAESCR.FI
  14         INCLUDE HAEHAS.FI
  15         INCLUDE HAETTY.FI
  16 C
  17         REAL WGET
  18         EXTERNAL WGET
  19 C
  20         INTEGER RECNUM,WORD,R,J
  21      *  , BUFCNT                        @ HOLDS NUMBER OF INPUT BUFFERS FOR UNIT 7
  22         DATA BUFCNT /2/
  23 \fC
  24         IF (.NOT.HSHDON) CALL MKHASH
  25         R=MOD(INDEX+1,PCKMAX)
  26         IF (R.EQ.0) R=PCKMAX
  27         WORD=INT(INDEX/PCKMAX)*HSHSIG+HASH(CHANEL+1,R)
  28         RECNUM=(WORD-1)/255+OFFSET      @ GET THE RECORD NUMBER
  29         DO 15 J=1,BUFCNT
  30         IF (RECNUM.EQ.INPREC(J)) GOTO 10 @ JUMP IF RECORD ALREADY IN BUFFER
  31 15      CONTINUE
  32         IF (RECNUM.GT.LASREC) GOTO 20   @ END OF FILE REACHED
  33 C
  34 C
  35         J=BUFCNT-RECACT+1               @ COMPUTE NEXT INPUT BUFFER
  36         GOTO (111,112),J
  37 111     IF (WFLAG(J).AND.INPREC(J).GE.1) WRITE (UNIT'INPREC(J)) BUFFER
  38         READ (UNIT'RECNUM) BUFFER
  39         GOTO 16
  40 112     IF (WFLAG(J).AND.INPREC(J).GE.1) WRITE (UNIT'INPREC(J)) BUFER2
  41         READ (UNIT'RECNUM) BUFER2
  42 16      CONTINUE
  43         WFLAG(J)=.FALSE.
  44         INPREC(J)=RECNUM
  45 10      CONTINUE
  46         WORD=MOD(WORD,255)
  47         IF (WORD.EQ.0) WORD=255
  48         RECACT=J                        @ BUFFER SWICTH
  49         GOTO (121,122),J
  50 121     ESAM=WGET(BUFFER,WORD)           @ EXTRACT THE WORD WANTED AND CONVERT TO REAL
  51         RETURN
  52 122     ESAM=WGET(BUFER2,WORD)
  53         RETURN
  54 20      CONTINUE                        @ END OF FILE ERROR MESSAGE
  55         WRITE (TTO,1) UNIT,INDEX,RECNUM,LASREC
  56         ESAM=4711                       @ MOTHERFUCKER --- GO HOME
  57         RETURN
  58 1       FORMAT (' EINHEIT',I2,' INDEX',I7,' SATZ',I7,
  59      *  ' SATZENDE',I7,' UEBERLESEN.')
  60         END
  61 \1a