******************************************************************************* * SoundTrack, v. 1.10 * * * * by * * * * L. Padilla (e-mail: padilla at domain "gae ucm es") * * * * Madrid, January 2003 * * * * Latest version at http://www.gae.ucm.es/~padilla/extrawork/soundtrack.f * ******************************************************************************* * REAL FUNCTION soundtrack (ms, clk) REAL +T ,S * LOGICAL CHAIN CHARACTER*128 CFILE * COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT COMMON /PAWCHC/ CFILE * COMMON/PAWIDN/IDNEVT,OBS(13), +T ,S * INTEGER clk, data, seq, n, half1, seen1, num0, tclk, stop REAL ms, ot, os, om, m, pm, dur0, dur1 IMPLICIT NONE m = s - os if (m .EQ. 0.) then m = om else m = m/abs (m) endif soundtrack = 1. if (stop .GT. 0) RETURN if (m .NE. pm .AND. seq .EQ. 0 .AND. (abs (s) .GT. ms .OR. data .GT. 0)) then seq = 1 else if (m .EQ. om .AND. seq .GT. 0) then seq = seq + 1 if (seq .GT. 3) then soundtrack = t - ot ot = t seq = 0 pm = m data = 1 if (n .EQ. 0 .AND. n .LE. clk) then dur0 = 0.004 dur1 = dur0 * 0.6 * write(*,*) 'X' else if (n .EQ. 1 .AND. n .LE. clk) then dur0 = soundtrack dur1 = dur0 * 0.6 * write(*,*) '0' else if (n .GT. 1 .AND. n .LT. clk) then dur0 = (dur0 + soundtrack)/2. dur1 = dur0 * 0.6 * write(*,*) '0' else if (soundtrack .GT. (dur0 + dur1)/2. .AND. half1 .EQ. 0) + then if (abs (soundtrack - dur0) .LT. dur0 - dur1) dur0 = (dur0 + soundtrack)/2. if (seen1 .GT. 0) then num0 = num0 + 1 if (num0 .GT. 12) tclk = 1 endif * write(*,*) '0' else if (soundtrack .LT. (dur0 + dur1)/2.) then if (tclk .GT. 0) stop = 1 if (abs (soundtrack - dur1) .LT. dur0 - dur1) dur1 = (dur1 + soundtrack)/2. half1 = half1 + 1 if (half1 .GT. 1) then half1 = 0 seen1 = 1 num0 = 0 * write(*,*) '1' endif else write(*,*) 'Bit', n, ' recognition error!' stop = 1 endif endif n = n + 1 endif else seq = 0 endif os = s om = m RETURN END