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

   1 C       -+-+-+-+-+ \ e  H A E S A C . F T  \ e -+-+-+-+-+
   2 C
   3 C       * UP 20-MAY-83 INSERT DOCUMENTATION
   4 C       * UP 13-JUL-83 IMPROVED SEARCH ALGORITHM
   5 C
   6 C       SCAN THE EOG SPECTRUM TO FETCH THE SACCADES
   7 C       THE EOG SPECTRUM IS STORED ON CHANNEL 0!
   8 C
   9         SUBROUTINE SACCAD (STARTW,ENDW,THRL,THRU,SACBEG,SACEND,
  10      *  SACAMP,NXTSAC,ERR)
  11 C
  12 C       STARTW                          ANFANG DES ZU DURCHSUCHENDEN FENSTERS
  13 C       ENDW                            ENDE DES FENSTERS
  14 C       THRL                            UNTERE SCHWELLE FUER FIR/DFIR FUNKTION
  15 C       THRU                            OBERE SCHWELLE
  16 C       SACBEG                          ZEITPUNKT DES BEGINS EINER RASCHEN PHASE
  17 C       SACCEND                         ZEITPUNKT DES ENDES EINER SACCADE
  18 C       SACAMP                          AMPLITUDE DER RASCHEN PHASE
  19 C       NXTSAC                          VON HIER AB WIRD NACH DER NAECHSTEN R.P. GESUCHT
  20 C       ERR                             FEHLER RUECKSPRUNG CODE
  21 C                                       1 KEINE SACCADE MEHR GEFUNDEN
  22 C                                       2 KEIN ENDE GEFUNDEN
  23 C                                       3 KEIN ENDE GEFUNDEN
  24 C
  25 C       INPUT PARAMETERS ARE
  26 C
  27         INTEGER STARTW,ENDW
  28         REAL THRL,THRU
  29 C
  30 C       OUTPUT PARAMETERS ARE
  31 C
  32         REAL SACAMP
  33         INTEGER NXTSAC,ERR,SACBEG,SACEND
  34 C
  35 C
  36         INCLUDE HAEBUF.FI
  37         INCLUDE HAECEO.FI
  38         INCLUDE HABRK.FI
  39 C
  40 \fC
  41 C  FOLGENDE SUCHSCHRITTE
  42 C1.     DO 20 I=STARTW,ENDW
  43 C       BESTIMME SACCADEN ANFANGSZEITPUNKT UND DIE ART DER RASCHEN PHASE
  44 C       IF DFIR(I) THEN TIME1:=I ; \ BEGINN DER RASCHEN PHASE \
  45 C       \ RICHTUNG DER RASCHEN PHASE := IF FIR(I) < 0 THEN AUF PHASE ELSE AB PHASE \
  46 C       ELSE DFIR(I) NICHT GEFUNDEN FEHLER #1 FI
  47 C
  48 C2.     DO 33 I=TIME1,ENDW
  49 C       SOLANGE DFIR(I) BESTIMME MAXIMUM VON FIR(I)  : AMP1:=MAX(ABS(FIR)) ;
  50 C       TIME2 := I AN DER STELLE AMP1 \ KORREKTUR DER ANFANGSZEIT SACBEG: \
  51 C       \ AN DER STELLE DES EXTREMWERTES VOM EOG NEHME DEN ANFANG DER R.P. AN \
  52 C       IF I=ENDW FEHLER # 2 \ DA KEIN SACCADENENDE GEFUNDEN\
  53 C       ELSE TIME3:= I FI
  54 C
  55 C3.     DO 50 I=TIME3,TIME3+10
  56 C       \ SUCHE IN DEN NAECHSTEN 10 MESSWERTEN DANN DFIR(I) \
  57 C       IF I=TIME3+10 THEN TIME4:=1 ; FEHLER # 3 ELSE
  58 C       TIME4:=I FI
  59 C
  60 C4.     DO 60 I=TIME4,ENDW
  61 C       \ SUCHE STELLE DES EXTREMWERTES VOM EOG UND NEHME DORT ENDE DER R.P. AN \
  62 C       TIME5:=SACEND:=I \ AND DER STELLE DES MAXIMUMS \
  63 C
  64 C5.     AUSGABE AUF DRUCKER:
  65 C       SACBEG, SACEND-SACBEG, -Y(SACBEG)+Y(SACEND),CH2(SACBEG)
  66 C
  67 \fC
  68         REAL ATHRL,ATHRU,SAC,SAC1,SAC2,SAC3,SAC4
  69         INTEGER I,TIME(5)
  70      *  ,HOME,EOGCHN                    @ ASSIGNED GOTO, CHANNEL NUMBER FOR THE EOG SPECTRUM
  71 C
  72 C       STATEMENT FUNCTIONS ARE:
  73 C
  74         BETW(AP0,BP0,CP0)=AP0.LE.BP0.AND.BP0.LT.CP0
  75         LOGICAL BETW
  76         FIR(IP0)=-XYSAM(IP0-4,EOGCHN)-XYSAM(IP0-3,EOGCHN)+
  77      *  XYSAM(IP0-1,EOGCHN)+2*XYSAM(IP0,EOGCHN)+XYSAM(IP0+1,EOGCHN)-
  78      *  XYSAM(IP0+3,EOGCHN)-XYSAM(IP0+4,EOGCHN) @ SAMCNT FINITE IMPULSE RESPONSE FILTER
  79 C
  80         DFIR(IP2)=.NOT.BETW(ATHRL,FIR(IP2),ATHRU)
  81         LOGICAL DFIR
  82 C
  83         DATA EOGCHN /0/                 @ CHANNEL # FOR THE EOG
  84 C
  85         ATHRL=THRL                      @ COMPILER ERROR IN STATEMENT FUNCTION
  86         ATHRU=THRU
  87         ERR=0
  88         SACAMP=0
  89 C
  90         DO 20 I=STARTW,ENDW
  91         IF(DFIR(I)) GOTO 30
  92 20      CONTINUE
  93         ERR=1                           @ NO SACCADE FOUND
  94         NXTSAC=ENDW
  95         SACBEG=ENDW
  96         SACEND=ENDW
  97         RETURN
  98 C
  99 30      TIME(1)=I                       @ TIME1 COMPUTED
 100         AMP1=-1
 101         TIME(2)=0
 102         DO 33 I=TIME(1),ENDW
 103         IF (.NOT.DFIR(I)) GOTO 35
 104         TE1=ABS(XYSAM(I,EOGCHN))        @ SEARCH FOR MIN/MAX OF EOG
 105         TIME(2)=NCOND(TE1.GE.AMP1,I,TIME(2)) @ AND THIS POINTS TO THE BEGINNING OF THE SACCADE
 106 33      AMP1=AMAX1(AMP1,TE1)
 107 35      CONTINUE                        @ TIME 2 COMPUTED
 108         TIME(3)=I                       @ TIME 3 COMPUTED
 109 C
 110         DO 50 I=TIME(3),TIME(3)+10
 111         IF (DFIR(I)) GOTO 53
 112 50      CONTINUE
 113         ERR=3
 114         SACBEG=STARTW
 115         SACEND=TIME(3)+10
 116         NXTSAC=TIME(1)+15
 117         RETURN
 118 53      TIME(4)=I                       @ TIME 4 COMPUTED
 119 C
 120         AMP2=-1
 121         TIME(5)=0
 122         DO 60 I=TIME(4),ENDW
 123         IF (.NOT.DFIR(I)) GOTO 65
 124         TE1=ABS(XYSAM(I,EOGCHN))        @ SEARCH FOR MIN/MAX OF EOG
 125         TIME(5)=NCOND(TE1.GE.AMP2,I,TIME(5)) @ AND THIS POINTS TO THE END OF THE SACCADE
 126 60      AMP2=AMAX1(AMP2,TE1)
 127 65      CONTINUE                        @ TIME 5 COMPUTED
 128 C
 129 C
 130         NXTSAC=I
 131         SACBEG=TIME(2)
 132         SACEND=TIME(5)
 133         SAC=XYSAM(SACEND,EOGCHN)
 134         SAC3=SAC
 135         ASSIGN 70 TO HOME
 136         GOTO 100
 137 70      SAC1=SAC
 138         SAC=XYSAM(SACBEG,EOGCHN)
 139         SAC4=SAC
 140         ASSIGN 71 TO HOME
 141         GOTO 100
 142 71      SAC2=SAC
 143         SACAMP=SAC1-SAC2
 144 CX      WRITE (3,4711) SAC1,SAC2,SAC3,SAC4
 145 4711    FORMAT (6H ---  ,1P,4E11.3)
 146         RETURN
 147 C
 148 C       INTERNAL SUBROUTINE
 149 C
 150 100     DO 110 I=1,8                    @ CALIBRATE FOR NEGATIVE ANGLE
 151         IF (SAC.GE.I*5.*EICH(1,I)+CALIBR) GOTO 120
 152 110     CONTINUE
 153         I=8
 154 120     IF (I.EQ.1) GOTO 130            @ BETWEEN 0 AND +40 DEG, CONTINUE SEARCH
 155         SAC=(SAC-CALIBR)/ABS(EICH(1,I))
 156         GOTO HOME
 157 130     I=I+1
 158         IF (SAC.LE.CALIBR) GOTO 120     @ 0 DEGREES
 159         DO 140 I=2,8
 160         IF (SAC.LE.I*5.*EICH(2,I)+CALIBR) GOTO 150
 161 140     CONTINUE
 162         I=8
 163 150     SAC=(SAC-CALIBR)/EICH(2,I)
 164         GOTO HOME
 165 C
 166         END
 167 \1a