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

   1 C       -+-+-+-+-+  \ e H A E C A L . F T  \ e -+-+-+-+-+
   2 C
   3 C       SACCADE CALIBRATION FOR EOG ANALYSIS
   4 C
   5         SUBROUTINE CALSAC
   6 C
   7         INCLUDE HAEBUF.FI
   8         INCLUDE HAEGSA.FI
   9         INCLUDE HAECEO.FI
  10         INCLUDE HAEPTI.FI
  11         INCLUDE HABRK.FI
  12 C
  13 \f       INTEGER J,I,N,I1,I2,S0,S1
  14         REAL SACOFS,TE1,SPKMIN,SPKMAX
  15         EXTERNAL COND,XYSAM
  16         REAL COND,XYSAM
  17 C
  18 C       STATEMENT FUNCTIONS ARE
  19 C
  20         SPKPOS(IP0)=INT(XYSAM(IP0,SPKCN)*SPKFAC+SPKOFS+.5)-180
  21         INTEGER SPKPOS
  22 C
  23 C
  24         IF (OPTION.EQ.11) GOTO 60       @ EI- PRINTS THE CALIBRATE VECTOR
  25         IF (OPTION.EQ.2)  GOTO 50       @ EI1 INSERT FACTOR 1
  26         CALL ASKHIM(2)                  @ ASK FOR BEGIN & ENDS
  27         S0=BEGIN*SAMRAT
  28         S1=ENDS*SAMRAT
  29 C
  30 C       COMPUTE SPEAKER DC OFFSET
  31 C
  32         SPKOFS=0
  33         SPMIN=9999
  34         SPMAX=-SPMIN
  35         DO 70 I=S0,S1
  36         TE1=SPKPOS(I)
  37         SPMIN=AMIN1(SPMIN,TE1)
  38 70      SPMAX=AMAX1(SPMAX,TE1)
  39         SPKOFS=-((SPMAX-SPMIN)*.5+SPMIN)
  40 C
  41 C
  42         CALL MOVE (-18,0,EICH)
  43         CALL MOVE (-18,0,PEICH)
  44 C
  45         DO 10 I=S0,S1
  46         I1=SPKPOS(I)
  47         IF (MOD(I1,5).NE.0) GOTO 10
  48         IF (IABS(I1).GT.30) GOTO 10
  49         I2=IABS(I1/5)+1
  50         I1=NCOND(I1.LT.0,1,2)           @ POSITION BETWEEN -40 AND 40 DEG. 5 DEG STEPS +- 1 DEG ERROR
  51         EICH(I1,I2)=XYSAM(I,0)+EICH(I1,I2)
  52         PEICH(I1,I2)=PEICH(I1,I2)+1
  53 10      CONTINUE
  54 C
  55 C       MITTELWERTE BERECHNEN
  56 C
  57         DO 20 I=1,9
  58         DO 20 J=1,2
  59 20      EICH(J,I)=EICH(J,I)/MAX0(PEICH(J,I),1) @ PREVENTS DIVIDE BY ZERO
  60         IF (PEICH(2,1).NE.0) GOTO 25
  61         WRITE (TTO,1)
  62         WRITE (TTO,2) EICH,PEICH        @ PRINT AN ERROR MSG
  63 50      CONTINUE                        @ EI1 COMES HERE
  64         CALL MOVE (-18,1.,EICH)
  65         CALIBR=0.                       @ NO CALIBRATION ASSUMED
  66         SPKOFS=0                        @ NO SPEAKER POSITION OFFSET
  67         RETURN
  68 60      WRITE (3,2) EICH,PEICH          @ PRINT THE CALIBRATE VECTOR
  69         RETURN
  70 25      SACOFS=EICH(2,1)                @ VALUE FOR 0 DEG
  71         DO 30 I=2,9
  72         DO 30 J=1,2
  73 30      EICH(J,I)=(EICH(J,I)-SACOFS)/((I-1)*5)
  74         DO 35 I=2,9
  75         DO 35 J=1,2
  76 35      EICH(J,I)=COND(PEICH(J,I),EICH(J,I),EICH(J,I-1))
  77         DO 40 N=3,9
  78         I=11-N
  79         DO 40 J=1,2
  80 40      EICH(J,I)=COND(PEICH(J,I),EICH(J,I),(EICH(J,I+1)+EICH(J,I))*.5)
  81         RETURN
  82 1       FORMAT (' KEINEN NULLDURCHGANG DES LAUTSPRECHERS GEFUNDEN, ',
  83      *  'KEINE EICHUNG!')
  84 2       FORMAT (1X,1P,4(2E11.3,2X)/1X,5(2E11.3,2X)/1X,
  85      *   0P,4(2F11.0,2X),/1X,5(2F11.0,2X))
  86         END
  87 \1a