⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dyptrk.f

📁 lpc 2400 bps语音编解码程序
💻 F
字号:
**********************************************************************
*
*	DYPTRK Version 52
*
**********************************************************************
*
*   Dynamic Pitch Tracker
*
*  Inputs:
*   AMDF   - Average Magnitude Difference Function array
*   LTAU   - Number of lags in AMDF
*   MINPTR - Location of minimum AMDF value
*   VOICE  - Voicing decision
*  Outputs:
*   PITCH  - Smoothed pitch value, 2 frames delayed
*   MIDX   - Initial estimate of current frame pitch
*  Compile time constant:
*   DEPTH  - Number of frames to trace back
*

	SUBROUTINE DYPTRK( AMDF, LTAU, MINPTR, VOICE, PITCH, MIDX )
	INCLUDE 'contrl.fh'
	INTEGER LTAU, MINPTR, VOICE, PITCH, MIDX
	REAL AMDF(LTAU), S(60), SBAR, MINSC, MAXSC, ALPHA
	INTEGER DEPTH
	PARAMETER (DEPTH=2)
	INTEGER P(60,DEPTH), PBAR, I, J, IPOINT, IPTR, PATH(DEPTH)
	REAL ALPHAX

*   Calculate the confidence factor ALPHA, used as a threshold slope in
*   SEESAW.  If unvoiced, set high slope so that every point in P array
*   is marked as a potential pitch frequency.  A scaled up version (ALPHAX)
*   is used to maintain arithmetic precision.

	IF( VOICE .EQ. 1 ) THEN
	   ALPHAX = .75*ALPHAX + AMDF(MINPTR)/2.
	ELSE
	   ALPHAX = (63./64.)*ALPHAX
	END IF
	ALPHA = ALPHAX/16
	IF( VOICE.EQ.0 .AND. ALPHAX.LT.128 ) ALPHA = 8

*  SEESAW: Construct a pitch pointer array and intermediate winner function
*   Left to right pass:

	IPTR = IPOINT+1
	P(1,IPTR) = 1
	I = 1
	PBAR = 1
	SBAR = S(1)
	DO I = 1,LTAU 
	   SBAR = SBAR + ALPHA
	   IF (SBAR.LT.S(I)) THEN
	      S(I) = SBAR
	      P(I,IPTR) = PBAR
	   ELSE
	      SBAR = S(I)
	      P(I,IPTR) = I
	      PBAR = I
	   END IF
	END DO

*   Right to left pass:

	I = PBAR-1
	SBAR = S(I+1)
	DO WHILE (I.GE.1)
	   SBAR = SBAR + ALPHA
	   IF (SBAR.LT.S(I)) THEN
	      S(I) = SBAR
	      P(I,IPTR) = PBAR
	   ELSE
	      PBAR = P(I,IPTR)
	      I = PBAR
	      SBAR = S(I)
	   END IF
	   I = I-1
	END DO

*   Update S using AMDF
*   Find maximum, minimum, and location of minimum

	S(1) = S(1) + AMDF(1)/2
	MINSC = S(1)
	MAXSC = MINSC
	MIDX = 1
	DO I = 2,LTAU
	   S(I) = S(I) + AMDF(I)/2
	   IF(S(I).GT.MAXSC) MAXSC = S(I)
	   IF(S(I).LT.MINSC) MIDX = I
	   IF(S(I).LT.MINSC) MINSC = S(I)
	END DO

*   Subtract MINSC from S to prevent overflow

	DO I = 1,LTAU
	   S(I) = S(I) - MINSC
	END DO
	MAXSC = MAXSC - MINSC

*   Use higher octave pitch if significant null there

	J = 0
	DO I = 20, 40, 10
	   IF (MIDX .GT. I) THEN
	      IF (S(MIDX-I) .LT. MAXSC/4) J = I
	   END IF
	END DO
	MIDX = MIDX - J

*   TRACE: look back two frames to find minimum cost pitch estimate

	J = IPOINT
	PITCH = MIDX
	DO I = 1,DEPTH
	   J = MOD(J,DEPTH) + 1
	   PITCH = P(PITCH,J)
	   PATH(I) = PITCH
	END DO
	IPOINT = MOD(IPOINT+DEPTH-1,DEPTH)

*   Print test data

	IF(LISTL.GE.3) THEN
	   IF(LISTL.GE.6) THEN
	      WRITE(FDEBUG,970) 'DYPTRACK array (P):',P
	      WRITE(FDEBUG,980) 'Pitch Winner Function (S):',S
	   END IF
	   WRITE(FDEBUG,950) IPOINT, MIDX, ALPHA, PITCH, PATH
950	   FORMAT(' Pitch: IPOINT  MIDX  ALPHA   PITCH     PATH'/
     1             5X,2I7,F7.0,I7,5X,10I4/)
970	   FORMAT(1X,A,100(/1X,20I6))
980	   FORMAT(1X,A,100(/1X,10F12.1))
	END IF

	RETURN
	END

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -