www.pudn.com > lpc10-15.zip > decode.f
******************************************************************
*
* DECODE Version 54
*
* $Log: decode.f,v $
* Revision 1.5 1996/05/23 20:06:03 jaf
* Assigned PITCH a "default" value on the first call, since otherwise it
* would be left uninitialized.
*
* 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,' <>',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,'<>',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,'<>',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