decode.f,v

lpc10-15为美军2400bps语音压缩标准的C语音源代码。

head	1.5;
access;
symbols;
locks; strict;
comment	@* @;


1.5
date	96.05.23.20.06.03;	author jaf;	state Exp;
branches;
next	1.4;

1.4
date	96.03.26.19.35.18;	author jaf;	state Exp;
branches;
next	1.3;

1.3
date	96.03.21.21.10.50;	author jaf;	state Exp;
branches;
next	1.2;

1.2
date	96.03.21.21.04.50;	author jaf;	state Exp;
branches;
next	1.1;

1.1
date	96.02.12.03.21.10;	author jaf;	state Exp;
branches;
next	;


desc
@@


1.5
log
@Assigned PITCH a "default" value on the first call, since otherwise it
would be left uninitialized.
@
text
@******************************************************************
*
*	DECODE Version 54
*
* $Log: decode.f,v $
* Revision 1.4  1996/03/26  19:35:18  jaf
* Commented out trace statements.
*
* Revision 1.3  1996/03/21  21:10:50  jaf
* Added entry INITDECODE to reinitialize the local state of subroutine
* DECODE.
*
* Revision 1.2  1996/03/21  21:04:50  jaf
* Determined which local variables should be saved from one invocation
* to the next, and guessed initial values for some that should have been
* saved, but weren't given initial values.  Many of the arrays are
* "constants", and many local variables are only used if the "global"
* variable CORRP is .TRUE.
*
* Added comments explaining which indices of array arguments are read or
* written.
*
* Revision 1.1  1996/02/12 03:21:10  jaf
* Initial revision
*
*
******************************************************************
*
*   This subroutine provides error correction and decoding
*   for all LPC parameters
*
* Input:
*  IPITV  - Index value of pitch
*  IRMS   - Coded Energy
*  CORRP  - Error correction:
*    If FALSE, parameters are decoded directly with no delay.  If TRUE,
*    most important parameter bits are protected by Hamming code and
*    median smoothed.  This requires an additional frame of delay.
* Input/Output:
*  IRC    - Coded Reflection Coefficients
*           Indices 1 through ORDER always read, then written.
* Output:
*  VOICE  - Half frame voicing decisions
*           Indices 1 through 2 written.
*  PITCH  - Decoded pitch
*  RMS    - Energy
*  RC     - Reflection coefficients
*           Indices 1 through ORDER written.
*
*  NOTE: Zero RC's should be done more directly, but this would affect
*   coded parameter printout.
* 
* This subroutine maintains local state from one call to the next.  If
* you want to switch to using a new audio stream for this filter, or
* reinitialize its state for any other reason, call the ENTRY
* INITDECODE.
*
	SUBROUTINE DECODE(IPITV, IRMS, IRC,
     1               VOICE, PITCH, RMS, RC )
	INCLUDE 'config.fh'
	INCLUDE 'contrl.fh'

*       Arguments

	INTEGER IPITV, IRMS, IRC(MAXORD)
	INTEGER VOICE(2), PITCH
	REAL RMS, RC(ORDER)

*       Function return value definitions

	INTEGER MEDIAN

*
*       Parameters/constants
*

*       The variables below that are not Fortran PARAMETER's are
*       initialized with DATA statements, and then never modified.

*       The following are used regardless of CORRP's value.
*       
*       DETAU, NBIT, QB, DEADD, DETAB7, RMST, DESCL
*       
*       The following are used only if CORRP is .TRUE.
*       
*       ETHRS, ETHRS1, ETHRS2, ETHRS3, IVTAB, BIT, CORTH, ZRC

	INTEGER FUT, PRES, PAST
	PARAMETER( FUT=1, PRES=2, PAST=3 )

	INTEGER ETHRS, ETHRS1, ETHRS2, ETHRS3
	INTEGER IVTAB(32), DETAU(128), BIT(5), NBIT(10)
	INTEGER QB(8), DEADD(8), DETAB7(32), RMST(64)
	REAL DESCL(8), CORTH(4,8)
	INTEGER ZRC(MAXORD)

*
*       Local variables that need not be saved
*

*       The following are used regardless of CORRP's value

	INTEGER I, J, I1, I2, I4, ISHIFT

*       The following are used only if CORRP is .TRUE.

	INTEGER IVOIC
	INTEGER ICORF, INDEX, IOUT
	INTEGER IPIT, IXCOR, LSB
	INTEGER ERRCNT

*
*       Local state
*

*       The following are used regardless of CORRP's value

	INTEGER IPTOLD

*       The following are used only if CORRP is .TRUE.

	LOGICAL FIRST
	INTEGER IVP2H, IOVOIC
	INTEGER IAVGP
	INTEGER ERATE
	INTEGER DRC(3,MAXORD), DPIT(3), DRMS(3)

	SAVE IPTOLD
	SAVE FIRST
	SAVE IVP2H, IOVOIC
	SAVE IAVGP
	SAVE ERATE
	SAVE DRC, DPIT, DRMS

*       I am guessing the initial values for IVP2H, IOVOIC, DRC, DPIT,
*       and DRMS.  They should be checked to see if they are reasonable.
*       I'm also guessing for ERATE, but I think 0 is the right initial
*       value.

	DATA FIRST /.TRUE./
	DATA IVP2H /0/, IOVOIC /0/
	DATA IAVGP /60/, IPTOLD /60/
	DATA ERATE /0/
	DATA DRC /30*0/, DPIT /3*0/, DRMS /3*0/

* DATA statements for "constants" defined above.

	DATA ETHRS,ETHRS1,ETHRS2,ETHRS3/O'4000',O'200',O'2000',O'4000'/

	DATA IVTAB/ 4*O'60600', 2*O'61610', O'61613', O'61610',
     1    O'40400', 3*O'3030', O'40400', O'3430', O'3033',
     1    O'3030', 2*O'60600', O'60433', O'60430', O'62621',
     1    O'62431', O'62473', O'62471', 2*O'3030', O'17170',
     1    O'7070', 2*O'3031', O'7073', O'7071' /

	DATA CORTH/32767.,10.,5.,0., 32767.,8.,4.,0.,
     1   32.,6.4,3.2,0., 32.,6.4,3.2,0., 32.,11.2,6.4,0.,
     1   32.,11.2,6.4,0., 16.,5.6,3.2,0., 16.,5.6,3.2,0. /

	DATA DETAU/ 0,0,0,3,0,3,3,31, 0,3,3,21,3,3,29,30,
     1         0,3,3,20,3,25,27,26, 3,23,58,22,3,24,28,3,
     1  	0,3,3,3,3,39,33,32, 3,37,35,36,3,38,34,3,
     1         3,42,46,44,50,40,48,3, 54,3,56,3,52,3,3,1,
     1  	0,3,3,108,3,78,100,104, 3,84,92,88,156,80,96,3,
     1  	3,74,70,72,66,76,68,3, 62,3,60,3,64,3,3,1,
     1  	3,116,132,112,148,152,3,3, 140,3,136,3,144,3,3,1,
     1         124,120,128,3,3,3,3,1, 3,3,3,1,3,1,1,1/

	DATA RMST/1024,936,856,784,718,656,600,550,
     1  	502,460,420,384,352,328,294,270,
     1  	246,226,206,188,172,158,144,132,
     1  	120,110,102,92,84,78,70,64,
     1  	60,54,50,46,42,38,34,32,
     1  	30,26,24,22,20,18,17,16,
     1  	15,14,13,12,11,10,9,8,
     1  	7,6,5,4,3,2,1,0/

	DATA DETAB7/4,11,18,25,32,39,46,53,60,66,72,77,82,87,92,96,101,
     1  	104,108,111,114,115,117,119,121,122,123,124,125,126,
     1  	127,127/

	DATA DESCL /.6953,.6250,.5781,.5469,.5312,.5391,.4688,.3828/
	DATA DEADD /1152,-2816,-1536,-3584,-1280,-2432,768,-1920/
	DATA QB /511,511,1023,1023,1023,1023,2047,4095/
	DATA NBIT /8,8,5,5,4,4,4,4,3,2/
	DATA ZRC /4*0,0,3,0,2,0,0/
	DATA BIT /2,4,8,16,32/


*	IF (LISTL.GE.3) WRITE(FDEBUG,800) IPITV,IRMS,(IRC(J),J=1,ORDER)
*800	FORMAT(1X,' <<ERRCOR IN>>',T32,6X,I6,I5,T50,10I8)

*  If no error correction, do pitch and voicing then jump to decode

	I4 = DETAU(IPITV+1)
	IF (.NOT.CORRP) THEN
	   VOICE(1) = 1
	   VOICE(2) = 1
	   IF (IPITV.LE.1) VOICE(1) = 0
	   IF ((IPITV.EQ.0).OR.(IPITV.EQ.2)) VOICE(2) = 0
	   PITCH = I4
	   IF (PITCH.LE.4) PITCH = IPTOLD
	   IF ((VOICE(1).EQ.1).AND.(VOICE(2).EQ.1)) IPTOLD = PITCH
	   IF (VOICE(1).NE.VOICE(2)) PITCH = IPTOLD
	   GOTO 900
	END IF

*  Do error correction pitch and voicing

	IF (I4.GT.4) THEN
	   DPIT(FUT) = I4
	   IVOIC = 2
	   IAVGP = (15*IAVGP+I4+8)/16
	ELSE
	   IVOIC = I4
	   DPIT(FUT) = IAVGP
	END IF
	DRMS(FUT) = IRMS
	DO I = 1,ORDER
	   DRC(FUT,I) = IRC(I)
	END DO

*  Determine index to IVTAB from V/UV decision
*  If error rate is high then use alternate table

	INDEX = 16*IVP2H + 4*IOVOIC + IVOIC + 1
	I1 = IVTAB(INDEX)
	IPIT = AND(I1,3)
	ICORF = I1/8
	IF (ERATE.LT.ETHRS) ICORF = ICORF/64

*  Determine error rate:  4=high    1=low

	IXCOR = 4
	IF (ERATE.LT.ETHRS3) IXCOR = 3
	IF (ERATE.LT.ETHRS2) IXCOR = 2
	IF (ERATE.LT.ETHRS1) IXCOR = 1

*  Voice/unvoice decision determined from bits 0 and 1 of IVTAB

	VOICE(1) = AND(ICORF/2,1)
	VOICE(2) = AND(ICORF,1)

*  Skip decoding on first frame because present data not yet available

	IF (FIRST) THEN
	   FIRST = .FALSE.

*          Assign PITCH a "default" value on the first call, since
*          otherwise it would be left uninitialized.  The two lines
*          below were copied from above, since it seemed like a
*          reasonable thing to do for the first call.

	   PITCH = I4
	   IF (PITCH.LE.4) PITCH = IPTOLD

	   GO TO 500
	END IF

*  If bit 4 of ICORF is set then correct RMS and RC(1) - RC(4).
*    Determine error rate and correct errors using a Hamming 8,4 code
*    during transition or unvoiced frame.  If IOUT is negative,
*    more than 1 error occurred, use previous frame's parameters.

	IF (AND(ICORF,BIT(4)).NE.0) THEN
	   ERRCNT = 0
	   LSB = AND(DRMS(PRES),1)
	   INDEX = DRC(PRES,8)*16 + DRMS(PRES)/2
	   CALL HAM84(INDEX,IOUT,ERRCNT)
	   DRMS(PRES) = DRMS(PAST)
	   IF (IOUT.GE.0) DRMS(PRES) = IOUT*2 + LSB

	   DO I = 1,4
	      IF (I.EQ.1) THEN
	         I1  = ( AND(DRC(PRES,9),7)*2 + AND(DRC(PRES,10),1) )
	      ELSE
	         I1  = AND(DRC(PRES,9-I),15)
	      END IF
	      I2 = AND(DRC(PRES,5-I),31)
	      LSB = AND(I2,1)
	      INDEX = 16*I1 + I2/2
	      CALL HAM84(INDEX,IOUT,ERRCNT)
	      IF (IOUT.GE.0) THEN
	         IOUT = IOUT*2+LSB
	         IF (AND(IOUT,16).EQ.16) IOUT = IOUT-32
	      ELSE
	         IOUT = DRC(PAST,5-I)
	      END IF
	      DRC(PRES,5-I) = IOUT
	   END DO

*  Determine error rate

	   ERATE = ERATE*.96875 + ERRCNT*102
*	   IF (ERATE.NE.0 .AND. LISTL.GE.3) WRITE(FDEBUG,987) ERATE,ERRCNT
*987	   FORMAT(' ERATE=',I6,'   ERRCNT=',I6)
	END IF

*  Get unsmoothed RMS, RC's, and PITCH

	IRMS = DRMS(PRES)
	DO I = 1,ORDER
	   IRC(I) = DRC(PRES,I)
	END DO
	IF (IPIT.EQ.1) DPIT(PRES) = DPIT(PAST)
	IF (IPIT.EQ.3) DPIT(PRES) = DPIT(FUT)
	PITCH = DPIT(PRES)

*  If bit 2 of ICORF is set then smooth RMS and RC's,

	IF (AND(ICORF,BIT(2)).NE.0) THEN
	   IF (  IABS(DRMS(PRES)-DRMS(FUT)) .GE. CORTH(IXCOR,2)
     1    .AND.IABS(DRMS(PRES)-DRMS(PAST)).GE. CORTH(IXCOR,2))
     1    IRMS = MEDIAN( DRMS(PAST), DRMS(PRES), DRMS(FUT) )
	   DO I = 1,6
	      IF (  IABS(DRC(PRES,I)-DRC(FUT,I)) .GE. CORTH(IXCOR,I+2)
     1       .AND.IABS(DRC(PRES,I)-DRC(PAST,I)).GE. CORTH(IXCOR,I+2))
     1       IRC(I) = MEDIAN( DRC(PAST,I), DRC(PRES,I), DRC(FUT,I) )
	   END DO
	END IF

*  If bit 3 of ICORF is set then smooth pitch

	IF (AND(ICORF,BIT(3)).NE.0) THEN
	   IF (  IABS(DPIT(PRES)-DPIT(FUT)) .GE. CORTH(IXCOR,1)
     1    .AND.IABS(DPIT(PRES)-DPIT(PAST)).GE. CORTH(IXCOR,1))
     1    PITCH = MEDIAN( DPIT(PAST), DPIT(PRES), DPIT(FUT) )
	END IF

*  If bit 5 of ICORF is set then RC(5) - RC(10) are loaded with
*  values so that after quantization bias is removed in decode
*  the values will be zero.

500	IF (AND(ICORF,BIT(5)).NE.0) THEN
	   DO I = 5,ORDER
	      IRC(I) = ZRC(I)
	   END DO
	END IF

*  House keeping  - one frame delay

	IOVOIC = IVOIC
	IVP2H = VOICE(2)
	DPIT(PAST) = DPIT(PRES)
	DPIT(PRES) = DPIT(FUT)
	DRMS(PAST) = DRMS(PRES)
	DRMS(PRES) = DRMS(FUT)
	DO I = 1,ORDER
	   DRC(PAST,I) = DRC(PRES,I)
	   DRC(PRES,I) = DRC(FUT,I)
	END DO

900	CONTINUE

*	IF (LISTL.GE.3)WRITE(FDEBUG,801)VOICE,PITCH,IRMS,(IRC(J),J=1,ORDER)
*801	FORMAT(1X,'<<ERRCOR OUT>>',T32,2I3,I6,I5,T50,10I8)

*   Decode RMS

	IRMS = RMST((31-IRMS)*2+1)

*  Decode RC(1) and RC(2) from log-area-ratios
*  Protect from illegal coded value (-16) caused by bit errors

	DO I = 1,2
	   I2 = IRC(I)
	   I1 = 0
	   IF (I2.LT.0) THEN
	      I1 = 1
	      I2 = -I2
	      IF (I2.GT.15) I2 = 0
	   END IF
	   I2 = DETAB7(2*I2+1)
	   IF (I1.EQ.1) I2 = -I2
	   ISHIFT = 15 - NBIT(I)
	   IRC(I) = I2*2**ISHIFT
	END DO

*  Decode RC(3)-RC(10) to sign plus 14 bits

	DO I = 3,ORDER
	   I2 = IRC(I)
	   ISHIFT = 15 - NBIT(I)
	   I2 = I2*2**ISHIFT
	   I2 = I2 + QB(I-2)
	   IRC(I) = I2*DESCL(I-2) + DEADD(I-2)
	END DO

*	IF (LISTL.GE.3) WRITE(FDEBUG,811) IRMS, (IRC(I),I=1,ORDER)
*811	FORMAT(1X,'<<DECODE OUT>>',T45,I4,1X,10I8)

*  Scale RMS and RC's to reals

	RMS = IRMS
	DO I = 1,ORDER
	   RC(I) = IRC(I) / 2.**14
	END DO

	RETURN


	ENTRY INITDECODE ()

	FIRST = .TRUE.
	IVP2H = 0
	IOVOIC = 0
	IAVGP = 60
	IPTOLD = 60
	ERATE = 0

	DO J = 1,3
	   DO I = 1,MAXORD
	      DRC(J,I) = 0
	   END DO
	   DPIT(J) = 0
	   DRMS(J) = 0
	END DO

	RETURN

	END
@


1.4
log
@Commented out trace statements.
@
text
@d6 3
d248 9
@


1.3
log
@Added entry INITDECODE to reinitialize the local state of subroutine
DECODE.
@
text
@d6 4
d187 2
a188 2
	IF (LISTL.GE.3) WRITE(FDEBUG,800) IPITV,IRMS,(IRC(J),J=1,ORDER)
800	FORMAT(1X,' <<ERRCOR IN>>',T32,6X,I6,I5,T50,10I8)
d283 2
a284 2
	   IF (ERATE.NE.0 .AND. LISTL.GE.3) WRITE(FDEBUG,987) ERATE,ERRCNT
987	   FORMAT(' ERATE=',I6,'   ERRCNT=',I6)
d341 4
a344 2
900	IF (LISTL.GE.3)WRITE(FDEBUG,801)VOICE,PITCH,IRMS,(IRC(J),J=1,ORDER)
801	FORMAT(1X,'<<ERRCOR OUT>>',T32,2I3,I6,I5,T50,10I8)
d377 2
a378 2
	IF (LISTL.GE.3) WRITE(FDEBUG,811) IRMS, (IRC(I),I=1,ORDER)
811	FORMAT(1X,'<<DECODE OUT>>',T45,I4,1X,10I8)
@


1.2
log
@Determined which local variables should be saved from one invocation
to the next, and guessed initial values for some that should have been
saved, but weren't given initial values.  Many of the arrays are
"constants", and many local variables are only used if the "global"
variable CORRP is .TRUE.

Added comments explaining which indices of array arguments are read or
written.
@
text
@d6 10
d45 5
d382 21
@


1.1
log
@Initial revision
@
text
@d5 4
a8 1
* $Log$
d15 1
a15 1
* INPUTS:
a17 1
*  IRC    - Coded Reflection Coefficients
d22 4
a25 1
* OUTPUTS:
d27 1
d31 1
d40 3
d46 25
a70 6
	LOGICAL FIRST
	INTEGER IVP2H, IVOIC, IOVOIC
	INTEGER I, J, I1, I2, I4, IAVGP, ICORF,INDEX, IOUT
	INTEGER IPIT, IPTOLD, ISHIFT, IXCOR, LSB, MEDIAN
	INTEGER ERRCNT, IVTAB(32), DETAU(128), BIT(5), NBIT(10)
	INTEGER ERATE, ETHRS, ETHRS1, ETHRS2, ETHRS3
d73 54
a126 3
	INTEGER FUT, PRES, PAST
	PARAMETER( FUT=1, PRES=2, PAST=3 )
	INTEGER DRC(3,MAXORD), ZRC(MAXORD), DPIT(3), DRMS(3)
d155 1
a163 1
	DATA ETHRS,ETHRS1,ETHRS2,ETHRS3/O'4000',O'200',O'2000',O'4000'/
a165 1
	DATA IAVGP/60/, IPTOLD/60/, FIRST/.TRUE./
d167 2
a168 1
	IF(LISTL.GE.3) WRITE(FDEBUG,800) IPITV,IRMS,(IRC(J),J=1,ORDER)
d174 1
a174 1
	IF(.NOT.CORRP) THEN
d177 2
a178 2
	   IF(IPITV.LE.1) VOICE(1) = 0
	   IF((IPITV.EQ.0).OR.(IPITV.EQ.2)) VOICE(2) = 0
d180 3
a182 3
	   IF(PITCH.LE.4) PITCH = IPTOLD
	   IF((VOICE(1).EQ.1).AND.(VOICE(2).EQ.1)) IPTOLD = PITCH
	   IF(VOICE(1).NE.VOICE(2)) PITCH = IPTOLD
d188 1
a188 1
	IF(I4.GT.4) THEN
d208 1
a208 1
	IF(ERATE.LT.ETHRS) ICORF = ICORF/64
d213 3
a215 3
	IF(ERATE.LT.ETHRS3) IXCOR = 3
	IF(ERATE.LT.ETHRS2) IXCOR = 2
	IF(ERATE.LT.ETHRS1) IXCOR = 1
d224 1
a224 1
	IF(FIRST) THEN
d234 1
a234 1
	IF(AND(ICORF,BIT(4)).NE.0) THEN
d240 1
a240 1
	   IF(IOUT.GE.0) DRMS(PRES) = IOUT*2 + LSB
d243 1
a243 1
	      IF(I.EQ.1) THEN
d252 1
a252 1
	      IF(IOUT.GE.0) THEN
d254 1
a254 1
	         IF(AND(IOUT,16).EQ.16) IOUT = IOUT-32
d264 1
a264 1
	   IF(ERATE.NE.0 .AND. LISTL.GE.3) WRITE(FDEBUG,987) ERATE,ERRCNT
d274 2
a275 2
	IF(IPIT.EQ.1) DPIT(PRES) = DPIT(PAST)
	IF(IPIT.EQ.3) DPIT(PRES) = DPIT(FUT)
d280 2
a281 2
	IF(AND(ICORF,BIT(2)).NE.0) THEN
	   IF(  IABS(DRMS(PRES)-DRMS(FUT)) .GE. CORTH(IXCOR,2)
d285 1
a285 1
	      IF(  IABS(DRC(PRES,I)-DRC(FUT,I)) .GE. CORTH(IXCOR,I+2)
d293 2
a294 2
	IF(AND(ICORF,BIT(3)).NE.0) THEN
	   IF(  IABS(DPIT(PRES)-DPIT(FUT)) .GE. CORTH(IXCOR,1)
d303 1
a303 1
500	IF(AND(ICORF,BIT(5)).NE.0) THEN
d322 1
a322 1
900	IF(LISTL.GE.3)WRITE(FDEBUG,801)VOICE,PITCH,IRMS,(IRC(J),J=1,ORDER)
d335 1
a335 1
	   IF(I2.LT.0) THEN
d338 1
a338 1
	      IF(I2.GT.15) I2 = 0
d341 1
a341 1
	   IF(I1.EQ.1) I2 = -I2
d356 1
a356 1
	IF(LISTL.GE.3) WRITE(FDEBUG,811) IRMS, (IRC(I),I=1,ORDER)
@