C -+-+-+-+-+  H A E C A L . F T  -+-+-+-+-+ C C SACCADE CALIBRATION FOR EOG ANALYSIS C SUBROUTINE CALSAC C INCLUDE HAEBUF.FI INCLUDE HAEGSA.FI INCLUDE HAECEO.FI INCLUDE HAEPTI.FI INCLUDE HABRK.FI C INTEGER J,I,N,I1,I2,S0,S1 REAL SACOFS,TE1,SPKMIN,SPKMAX EXTERNAL COND,XYSAM REAL COND,XYSAM C C STATEMENT FUNCTIONS ARE C SPKPOS(IP0)=INT(XYSAM(IP0,SPKCN)*SPKFAC+SPKOFS+.5)-180 INTEGER SPKPOS C C IF (OPTION.EQ.11) GOTO 60 @ EI- PRINTS THE CALIBRATE VECTOR IF (OPTION.EQ.2) GOTO 50 @ EI1 INSERT FACTOR 1 CALL ASKHIM(2) @ ASK FOR BEGIN & ENDS S0=BEGIN*SAMRAT S1=ENDS*SAMRAT C C COMPUTE SPEAKER DC OFFSET C SPKOFS=0 SPMIN=9999 SPMAX=-SPMIN DO 70 I=S0,S1 TE1=SPKPOS(I) SPMIN=AMIN1(SPMIN,TE1) 70 SPMAX=AMAX1(SPMAX,TE1) SPKOFS=-((SPMAX-SPMIN)*.5+SPMIN) C C CALL MOVE (-18,0,EICH) CALL MOVE (-18,0,PEICH) C DO 10 I=S0,S1 I1=SPKPOS(I) IF (MOD(I1,5).NE.0) GOTO 10 IF (IABS(I1).GT.30) GOTO 10 I2=IABS(I1/5)+1 I1=NCOND(I1.LT.0,1,2) @ POSITION BETWEEN -40 AND 40 DEG. 5 DEG STEPS +- 1 DEG ERROR EICH(I1,I2)=XYSAM(I,0)+EICH(I1,I2) PEICH(I1,I2)=PEICH(I1,I2)+1 10 CONTINUE C C MITTELWERTE BERECHNEN C DO 20 I=1,9 DO 20 J=1,2 20 EICH(J,I)=EICH(J,I)/MAX0(PEICH(J,I),1) @ PREVENTS DIVIDE BY ZERO IF (PEICH(2,1).NE.0) GOTO 25 WRITE (TTO,1) WRITE (TTO,2) EICH,PEICH @ PRINT AN ERROR MSG 50 CONTINUE @ EI1 COMES HERE CALL MOVE (-18,1.,EICH) CALIBR=0. @ NO CALIBRATION ASSUMED SPKOFS=0 @ NO SPEAKER POSITION OFFSET RETURN 60 WRITE (3,2) EICH,PEICH @ PRINT THE CALIBRATE VECTOR RETURN 25 SACOFS=EICH(2,1) @ VALUE FOR 0 DEG DO 30 I=2,9 DO 30 J=1,2 30 EICH(J,I)=(EICH(J,I)-SACOFS)/((I-1)*5) DO 35 I=2,9 DO 35 J=1,2 35 EICH(J,I)=COND(PEICH(J,I),EICH(J,I),EICH(J,I-1)) DO 40 N=3,9 I=11-N DO 40 J=1,2 40 EICH(J,I)=COND(PEICH(J,I),EICH(J,I),(EICH(J,I+1)+EICH(J,I))*.5) RETURN 1 FORMAT (' KEINEN NULLDURCHGANG DES LAUTSPRECHERS GEFUNDEN, ', * 'KEINE EICHUNG!') 2 FORMAT (1X,1P,4(2E11.3,2X)/1X,5(2E11.3,2X)/1X, * 0P,4(2F11.0,2X),/1X,5(2F11.0,2X)) END