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

   1 C       -+-+-+-+-+ \ e  H A E E O G . F T  \ e -+-+-+-+-+
   2 C
   3 C       EOG ANALYSIS
   4 C
   5         SUBROUTINE EOGSCN
   6         INCLUDE HAEBUF.FI
   7         INCLUDE HAEPTI.FI
   8         INCLUDE HAEGSA.FI
   9         INCLUDE HAECEO.FI
  10         INCLUDE HAETTY.FI
  11         INCLUDE HABRK.FI
  12 C
  13 \f       EXTERNAL TOASCI,REASAC
  14         INTEGER TOASCI
  15         REAL REASAC
  16 C
  17 C
  18         INTEGER POS1,I,N,
  19      *  SACBEG,SACEND,                  @ BEGINNING & ENDING OF SACCADE
  20      *  NXTSAC,                         @ HERE WE START FOR THE NEXT SEARCH
  21      *  S0,S1,                          @ WINDOW TO SCAN FOR SACCADE
  22      *  ERR,                            @ SACCAD ERROR NUMBER
  23      *  SPEAKR(73),LSTPOS,VLSTPO,       @ SPEAKER POSITIONS HISTOGRAM
  24      *   BHH,BMM,BSS,EHH,EMM,ESS,        @ TO EDIT OUTPUT LINE
  25      *   SACSTK(2,7,73),I1,I2,I3,Q1,Q2,Q3(8),Q4(8) @ STATISTIK STACK
  26         REAL THRL,THRU,                 @ LOWER AND UPPER THRESHOLD FOR SACCAD SUBROUTINE
  27      *  SACAMP,                         @ AMPLITUDE OF THE SACCADE (INSERTED BY SACCAD)
  28      *  TE1,TE2,TE3,TE4,                @ TEMP STORAGE FOR OUTPUT EDITING
  29      *  AMPL,AMPU                       @ TO CALIBRATE THE SACCADE AMPLITUDE
  30 C
  31 C       STATEMENT FUNCTIONS ARE
  32 C
  33         SPKPOS(IP0)=INT(XYSAM(IP0,SPKCN)*SPKFAC+SPKOFS+.5)
  34         INTEGER SPKPOS
  35         SPKPNT(IP1)=MIN0(MAX0((SPKPOS(IP1))/5+1,1),73)
  36         INTEGER SPKPNT
  37         EOFLOP(IP0)=IP0-S0.LT.SAMRAT    @ END OF LOOP INDICATOR ( 1 SEC STILL REMAINS)
  38         LOGICAL EOFLOP
  39         MODE(IP0)=XYSAM(IP0,MODCN)
  40         INTEGER MODE
  41 C
  42         IF (SAMCNT.EQ.0) RETURN         @ NO SAMPLE IN BUFFER
  43         IF (BREAK(11)) RETURN           @ USER GETS RID OF PROGRAM
  44         IF (OPTION.NE.12) CALL ASKHIM(2) @ EO* DOES NOT ASK FOR BEGIN, SPAN
  45         IF (BREAK(11)) RETURN           @ BLAH BLAH BLAH
  46 C
  47 C       ASK FOR THRESHOLD
  48 C
  49         THRL=40.                        @ DEFAULT
  50         THRU=40.
  51         IF (OPTION.NE.11) GOTO 30
  52         WRITE (TTO,1)
  53         READ (TTI,2) THRL,THRU          @ NO SIGN PLEASE!
  54         IF (BREAK(11)) RETURN           @ USER GETS ....
  55         IF (THRL.GE.0) GOTO 30          @ NO SIGN IS THE CORRECT ONE
  56         WRITE (TTO,5)                   @ TYPE A MSG, NO SIGN PLEASE
  57         THRL=-THRL                      @ AND BEHAVE LIKE A GENTLEMAN
  58 30      THRL=-THRL                      @ LOWER LIMIT MUST BE NEGATIVE
  59         BSS=TOASCI(MOD(BEGIN,60))
  60         BMM=TOASCI(MOD(BEGIN/60,60))
  61         BHH=TOASCI(BEGIN/3600)
  62         ESS=TOASCI(MOD(ENDS,60))
  63         EMM=TOASCI(MOD(ENDS/60,60))
  64         EHH=TOASCI(ENDS/3600)
  65 C
  66         WRITE (3,3) BHH,BMM,BSS,EHH,EMM,ESS,LABEL
  67         WRITE (9,3) BHH,BMM,BSS,EHH,EMM,ESS,LABEL
  68 C
  69         S0=BEGIN*SAMRAT                 @ START OF MAJOR LOOP
  70 C
  71 \f100    CONTINUE
  72         CALL MOVE (-73*2*7,0,SACSTK)    @ CLEAR STATISTIK BUFFER
  73         CALL CMODE (S0,S1)              @ COMPUTE S1, THE BOUNDER FOR SACCADE SEARCH
  74 C
  75 C       COMPUTE MIN/MAX OF EOG SIGNAL
  76 C
  77         AMPL=999
  78         AMPU=-AMPL
  79         DO 120 I=S0,S1
  80         TE1=XYSAM(I,0)
  81         AMPL=AMIN1(AMPL,TE1)
  82         AMPU=AMAX1(AMPU,TE1)
  83 120     CONTINUE
  84         AMPU=REASAC(AMPU)
  85         AMPL=REASAC(AMPL)               @ CALIBRATE INTO DEG SCALE
  86         I=S0/SAMRAT
  87         BSS=TOASCI(MOD(I,60))
  88         BMM=TOASCI(MOD(I/60,60))
  89         BHH=TOASCI(I/3600)
  90         I=S1/SAMRAT
  91         ESS=TOASCI(MOD(I,60))
  92         EMM=TOASCI(MOD(I/60,60))
  93         EHH=TOASCI(I/3600)
  94         TE1=MODE(S0)
  95         WRITE (9,6) LABEL,BHH,BMM,BSS,EHH,EMM,ESS,
  96      *   TE1,AMPL,AMPU
  97         WRITE (3,6) LABEL,BHH,BMM,BSS,EHH,EMM,ESS,
  98      *   TE1,AMPL,AMPU
  99 C
 100 C       COUNT THE NUMBER OF SPEAKER TURNS FROM S0 TO S1 ( I.E. FOR THE SAME MODE SIGNAL )
 101 C
 102         CALL MOVE (-73,0,SPEAKR)
 103         DO 110 I=S0,S1,2
 104         J=SPKPNT(I)
 105         IF (J.EQ.LSTPOS .OR. J.EQ.VLSTPO) GOTO 110      @ PREVENT MULTIPLE COUNTING
 106         SPEAKR(J)=SPEAKR(J)+1
 107         VLSTPO=LSTPOS                   @ SAVE VERY LAST POSITION
 108         LSTPOS=J                        @ SAVE LAST POSITION
 109 110     CONTINUE
 110 C
 111         POS1=S0                         @ HERE WE START THE SEARCH LOOP
 112 C
 113 C       MINOR LOOP TO FETCH THE SACCADE ONE BY ONE
 114 C
 115 10      CONTINUE                        @ LOOP TO FETCH THE NEXT SACCADE
 116         CALL SACCAD(POS1,S1,THRL,THRU,SACBEG,SACEND,
 117      *  SACAMP,NXTSAC,ERR)
 118         TE1=SACBEG/FLOAT(SAMRAT)        @ BEGINING OF THE SACCADE
 119         BSS=TOASCI(MOD(TE1,60))
 120         BMM=TOASCI(MOD(TE1/60,60))
 121         BHH=TOASCI(TE1/3600)
 122         TE2=(SACEND-SACBEG)/FLOAT(SAMRAT) @ DURATION
 123         TE3=SPKPOS(SACBEG)-180.         @ COMPUTE SPEAKER POSITION
 124         I=MOD(INT(TE1*10.),10)
 125         WRITE (3,4) BHH,BMM,BSS,I,TE2,SACAMP,TE3,ERR
 126 C
 127 C       INSERT DATA INTO STATISTIK BUFFER
 128 C
 129         IF (ERR.NE.0) GOTO 20           @ ERROR FLAG SET, NO SACCADE FOUND
 130         I1=NCOND(SACAMP.LT.0,1,2)       @ SACAMP<0 --> 1 ELSE 2
 131         I2=MIN1(ABS(SACAMP/5.)+1.,7.)   @ 0-5, -10, -15, -20, -25, -30, >30
 132         I3=SPKPNT(SACBEG)
 133         SACSTK(I1,I2,I3)=SACSTK(I1,I2,I3)+1 @ HISTOGRAM
 134 C
 135 C
 136 20      POS1=NXTSAC                     @ PREP FOR THE NEXT LOOP
 137         IF (S1-NXTSAC.GT.SAMRAT) GOTO 10 @ NO MODE CHANGE, SO CONTINUE MINOR LOOP
 138         S0=S1+5                         @ MODE CHANGES, REPEAT MAJOR LOOP
 139 C
 140 C       PRINT THE HISTOGRAM
 141 C
 142         CALL MOVE (-8,0,Q3)
 143         CALL MOVE (-8,0,Q4)
 144         DO 40 I=1,73,6
 145         J=-180+(I-1)*5
 146         WRITE (9,7) J
 147         DO 40 I3=I,MIN0(I+5,73)
 148         Q1=0
 149         Q2=0
 150         DO 42 N=1,7
 151         Q1=SACSTK(1,N,I3)+Q1
 152         Q2=SACSTK(2,N,I3)+Q2
 153         Q3(N)=SACSTK(1,N,I3)+Q3(N)
 154 42      Q4(N)=SACSTK(2,N,I3)+Q4(N)
 155         Q3(8)=Q1+Q3(8)
 156         Q4(8)=Q2+Q4(8)
 157 40      WRITE (9,8) SPEAKR(I3),((SACSTK(I1,I2,I3),I1=1,2),I2=1,7),
 158      *  Q1,Q2
 159
 160         WRITE (9,9) (Q3(I),Q4(I),I=1,8)
 161         WRITE (9,101)                   @ NEW PAGE
 162         IF (EOFLOP(ENDS*SAMRAT)) RETURN @ WORK DONE
 163         GOTO 100
 164 1       FORMAT (' U/O SCHWELLENWERT (2F3.0) ',$)
 165 2       FORMAT (2F3.0)
 166 3       FORMAT (1H1,80X/1X,2(2(A2,1H:),A2,3H - ),5X,10A6)
 167 4       FORMAT (1X,2(A2,1H:),A2,1H.,I1,F7.3,2F8.0,I5)
 168 5       FORMAT (' KEINE VORZEICHEN BITTE, WEISS ICH SELBER RICHTIG!')
 169 6       FORMAT (80X/1X,10A6/1X,2(2(A2,1H:)A2,3H - ),'MODE:',F6.0,
 170      *  ' SCHLAGFELD:',F6.0,2H /,F6.0/)
 171 7       FORMAT (1X,I4)
 172 8       FORMAT (1H+,2X,I6,1H*,7(2I4,2X),1H*,2I4/1X)
 173 9       FORMAT (10X,7(2I4,2X),1H#,2I4)
 174 101     FORMAT (1H1)
 175         END
 176 \1a