Digital Signal Processing (VB6)

'======================================================================
' Descrizione.....: Collezione di routines e costanti di utilita'
'                   per il Digital Signal Processing.

'======================================================================
'
'   Le routines di questo modulo sono un sotto insieme
'   di quelle contenute nel progetto FiltCalc (sito dei
'   DownLoads) e sono state modificate per adattarle a
'   questa applicazione.
'   Non tutte le costanti e le routines di questo
'   modulo vengono, necessariamente, usate.
'
OptionExplicit
'
'--- Windows ----------------------------------------------------------
PublicTypeWindow_Type'
NomeAsString' Nome della "Window":
PMinAsDouble' Valore Min. del Parametro associato.
PMaxAsDouble' Valore Max. del Parametro associato.
PCorAsDouble' Valore corrente del Parametro associato.
EndType
'
PrivateConstA0#=0.99938' Coefficienti per la
PrivateConstA1#=0.041186' Weber Window.
PrivateConstA2#=-1.637363'
PrivateConstA3#=0.828217'
PrivateConstB0#=1.496611'
PrivateConstB1#=-1.701521'
PrivateConstB2#=0.372793'
PrivateConstB3#=0.0650621'
'
'--- Spettro mobile (sliding spectrum) -------------------------------------------------
'   Implementazione dei circuiti tratti da:
'"Theory and Application of Digital Signal Processing"
'    di L. Rabiner e B. Gold. - pg. 382, 383.
'
PrivateNsSpm&' N° di campioni per il calcolo dello spettro mobile.
PrivateNormSpm#' Fattore di normalizzazione sul N° di campioni.
'
' Coefficienti per il calcolo con convoluzione diretta:
Privatez1()AsComplex'  vettore dei coefficienti di calcolo dello spettro mobile.
PrivateSmRE#()'  registro a scorrimento dei campioni del segnale.
'
' Coefficienti per il calcolo  ricorsivo:
PrivateSn_1AsComplex'  Sn * Z^-1.
Privatez1_1AsComplex'  z1(0)^-1
Privatez1_NAsComplex'  z1(0)^-N
PrivateIc&,Kc&'  indici in SmRE() per buffer circolare.
PrivateNsSpm1&'  NsSpm + 1.
PrivateXz1_NAsComplex'  variabili di appoggio.
PrivateYz1_1AsComplex'"""
PrivateSnIAsComplex'"""
PrivateSnAsComplex'"""
'
' Per multi frequenza:
PrivateNFreqSPM_1&' N° di frequenze - 1 a cui calcolare gli spettri.
' Coefficienti per il calcolo ricorsivo multi frequenza:
PrivateSn_MF_1()AsComplex'  vettore degli (NFreqSPM_1 + 1) Sn * Z^-1
Privatez1_MF_1()AsComplex'  z1()^-1
Privatez1_MF_N()AsComplex'  z1()^-N
'
PrivateSqRE#()' Registro a scorrimento dei campioni del segnale al quadrato.
PrivateVMed#' Valore medio corrente.
'
'--- Filtri FIR ------------------------------------------------------------------------
'   Algoritmi tradotti ed adattati dal FORTRAN di:
'"Digital Filters and their Applications"
'     di V. Cappellini, A. G. Constantinides, P. Emiliani.
'     Window method:  pg. 350.
'
PrivateHc!()' Vettore dei coefficienti del filtro.
'
PrivateWF#()' Tabella dei coefficienti per Windowing.
'
PrivateSRE!()' Registro a scorrimento dei Dati da Filtrare.
'
PrivateConstFiltroErrFIR$="Le Routines di calcolo hanno trovato"&vbNewLine_
&"una condizione imprevista."&vbNewLine_
&"Provare a rivedere i parametri del filtro."&vbNewLine&vbNewLine
'
'--- Filtri IIR ------------------------------------------------------------------------
'   Gli algoritmi per la sintesi di filtri del tipo Butterworth
'   e Chebyshev sono stati tradotti ed adattati dal FORTRAN di:
'"Digital Filters and their Applications"
'     di V. Cappellini, A. G. Constantinides, P. Emiliani.
'     pg. 367, 368, 369.
'   Metodi di calcolo dei filtri elementari.
'   - Algoritmi di trasformazione da "Digital Signal Processing"
'     di W. D. Stanley - pg. 172, 173, 174.
'   - La funzione di trasferimento del risuonatore reale parallelo
'     e' tratta da "Teoria delle Reti Elettriche", Appunti dai
'     corsi del Politecnico di Torino - pg. (1.3)1 e seg.
'   - L' idea della sostituzione degli zeri per il "Notch Filter"
'     proviene da: http://www-users.cs.york.ac.uk/~fisher/mkfilter/res.html
'
PrivateNK&,NCel&' Ordine e numero di sezioni del filtro.
PrivateAc!()' Coefficienti del filtro.
PrivateBc!()'"""
'
PrivateConstNCMax&=20' N. Massimo di sezioni del filtro.                                                                         ¦
'
Privatew!()' Registri delle sezioni del filtro.
'
PrivateCEB#(1To2*NCMax+1)' Vettori in uso durante la sintesi.
PrivateAN#(0To4,0To2)'""""
PrivateFINA#(0To2)'""""
PrivateFINB#(0To2)'""""
'
PrivateConstFiltroErrIIR$="Le Routines di calcolo hanno trovato"&vbNewLine_
&"una condizione imprevista."&vbNewLine_
&"Provare a rivedere i parametri del filtro."&vbNewLine&vbNewLine
'
'--- Per routines SFFTBI e SFTTBF ------------------------------------------------------
PrivateMM&' integer such that N = 2**MM
PrivateS1#()' array of sin() table (length >= n/8-1)
PrivateC1#()' array of cos() table (length >= n/8-1)
PrivateS3#()' array of sin() table (length >= n/8-1)
PrivateC3#()' array of cos() table (length >= n/8-1)
PrivateITAB&()' integer bit reversal table (length >= sqrt(2n))
PrivateD1#()' Vettore dei dati di ingresso a base 1, come richiesto dal FORTRAN.
'
'--- Per auto e mutua correlazione con SFFTBI_Corr, SFTTBF_Corr e SFFTBB_Corr ----------
PrivateN1_C&' N° di valori in D1().
PrivateN2_C&' N° di valori in D2().
PrivateMM_C&' MM_C = Ceil(Log(CDbl(N1_C + N2_C - 1)) / Log2)
PrivateN_C&' N_C =  2**MM_C
PrivateS1_C#()' array of sin() table (length >= N_C/8-1)
PrivateC1_C#()' array of cos() table (length >= N_C/8-1)
PrivateS3_C#()' array of sin() table (length >= N_C/8-1)
PrivateC3_C#()' array of cos() table (length >= N_C/8-1)
PrivateITAB_C&()' integer bit reversal table (length >= sqrt(2*N_C))
PrivateD1_C#()' Vettore dei dati di ingresso a base 1, come richiesto dal FORTRAN.
PrivateNFre_C&' N° di frequenze calcolate.
PrivateWnRe#()' Tavole dei seni/coseni per il calcolo della trasformata del
PrivateWnIm#()' segnale ritardato di N1_C campioni (solo per AutoCorr_FT).
PrivateRe1_C#()' Parte reale       della 1° trasformata.
PrivateIm1_C#()'"   immaginaria   """
PrivateRe2_C#()' Parte reale       della 2° trasformata.
PrivateIm2_C#()'"   immaginaria   """
Privates#(),f#()' Vettori d' appoggio.
'
'--- API di gestione memoria: ----------------------------------------------------------
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"_
(hpvDestAsAny,hpvSourceAsAny,ByValnumBytesAsLong)
'
PrivateDeclareSubMoveMemoryLib"kernel32"Alias"RtlMoveMemory"_
(hpvDestAsAny,hpvSourceAsAny,ByValnumBytesAsLong)
'
PrivateDeclareSubZeroMemoryLib"kernel32"Alias"RtlZeroMemory"_
(hpvDestAsAny,ByValnumBytesAsLong)
PublicFunctionEliminaCC(d()AsDouble,OptionalByRefVMedAsDouble)AsDouble()
'
'   Ritorna i dati del vettore D(0 To N) dopo l' eliminazione
'   della componente continua. I dati risultanti avranno, quindi,
'   valor medio = 0.  Ritorna anche VMed, valor medio dei dati in D().
'
DimI&,N&,dd#()
'
dd()=d()
N=UBound(dd)
VMed=0#
'
ForI=0ToN
VMed=VMed+dd(I)
NextI
VMed=VMed/(N+1)
'
ForI=0ToN
dd(I)=dd(I)-VMed
NextI
'
EliminaCC=dd()
'
'
'
EndFunction
PublicFunctionSPM(ByValXn!)AsSingle
'
'   Funzione per il calcolo con convoluzione diretta dello
'   spettro mobile (sliding spectrum) su NsSpm campioni.
'   Devono essere stati definiti, precedentemente, il vettore
'   dei coefficienti Z1() ed un vettore SmRE(0 To NsSpm - 1) da
'   usare come registro a scorrimento dei campioni del segnale.
'
DimK&
'
ForK=NsSpm-1To1Step-1
SmRE(K)=SmRE(K-1)
NextK
SmRE(0)=CDbl(Xn)
'
Sn=CCmp(SmRE(0),0#)
ForK=1ToNsSpm-1
Sn=CSom(Sn,CMol(CCmp(SmRE(K),0#),z1(K)))
NextK
'
SPM=CSng(CAbs(Sn))/CDbl(NsSpm)
'
'
'
EndFunction
PublicSubSPM_Init(ByValNsSpm_IAsLong,ByValFreqAsDouble,ByValFsAsDouble)
'
'   Calcolo dei coefficienti necessari alla
'   implementazione con convoluzione diretta
'   dello spettro mobile su NsSpm campioni:
'
DimI&,OmegaT#
'
NsSpm=NsSpm_I' N° di campioni per il calcolo dello spettro mobile.
NormSpm=CDbl(NsSpm)/2#' Fattore di normalizzazione sul N° di campioni.
'
ReDimz1(0ToNsSpm)' Vettore dei coefficienti di calcolo con
' convoluzione diretta dello spettro mobile;
' z1(0) = e^j*omega*T.
ReDimSmRE#(0ToNsSpm)' Registro a scorrimento dei campioni del segnale.
'
OmegaT=PI2*Freq/Fs' Per frequenza in [Hz].
'OmegaT = PI2 * Freq         ' Per frequenza in [f/fs].
z1(0)=CExp(CCmp(0#,OmegaT))
'
' Per calcolo con convoluzione diretta:
ForI=1ToNsSpm-1
z1(I)=CPtN(z1(0),-I)
NextI
'
'
'
EndSub
PublicSubSPM_R_Init(ByValNsSpm_IAsLong,ByValFreqAsDouble,ByValFs_IAsDouble)
'
'   Calcolo dei coefficienti necessari alla
'   implementazione ricorsiva dello spettro
'   mobile su NsSpm campioni:
'
DimI&,OmegaT#
'
NsSpm=NsSpm_I' N° di campioni per il calcolo dello spettro mobile.
NsSpm1=NsSpm+1
NormSpm=CDbl(NsSpm)/2#' Fattore di normalizzazione sul N° di campioni.
'
ReDimz1(0To0)' z1(0) = e^j*omega*T.
ReDimSmRE#(0ToNsSpm)' Registro a scorrimento dei campioni del segnale.
'
OmegaT=PI2*Freq/Fs_I' Per frequenza in [Hz].
'OmegaT = PI2 * Freq         ' Per frequenza in [f/fs].
z1(0)=CExp(CCmp(0#,OmegaT))
'
' Per calcolo ricorsivo:
Sn_1=CCmp(0#,0#)
z1_1=CPtN(z1(0),-1)
z1_N=CPtN(z1(0),-NsSpm)
'
'
'
EndSub
PublicSubSPM_MF_R_Init(ByValNsSpm_IAsLong,ByValNFREAsLong,Freq()AsDouble,_
ByValFsAsDouble)
'
'   Calcolo dei coefficienti necessari alla
'   implementazione ricorsiva, multi frequenza
'   dello spettro mobile su NsSpm campioni.
'   Le frequenze, a cui calcolare gli spettri,
'   devono essere definite nel vettore Freq(0 to NFreqSPM_1):
'
DimI&,OmegaT#
'
NsSpm=NsSpm_I' N° di campioni per il calcolo dello spettro mobile.
NsSpm1=NsSpm+1
NFreqSPM_1=NFRE-1' N° di frequenze - 1 a cui calcolare gli spettri.
NormSpm=CDbl(NsSpm)/2#' Fattore di normalizzazione sul N° di campioni.
'
ReDimz1(0To0)' z1(0) = e^j*omega*T.
ReDimSmRE(0ToNsSpm)' Registro a scorrimento dei campioni del segnale.
ReDimSqRE(0ToNsSpm)' Registro a scorrimento dei campioni del segnale al quadrato.
VMed=0#' Valore medio corrente.
'
ReDimSn_MF_1(0ToNFreqSPM_1)
ReDimz1_MF_1(0ToNFreqSPM_1)
ReDimz1_MF_N(0ToNFreqSPM_1)
'
ForI=0ToNFreqSPM_1
OmegaT=PI2*Freq(I)/Fs' Per frequenze in [Hz].
'OmegaT = PI2 * Freq(I)         ' Per frequenze in [f/fs].
z1(0)=CExp(CCmp(0#,OmegaT))
'
' Per calcolo ricorsivo:
Sn_MF_1(I)=CCmp(0#,0#)
z1_MF_1(I)=CPtN(z1(0),-1)
z1_MF_N(I)=CPtN(z1(0),-NsSpm)
NextI
'
'
'
EndSub
PublicSubSPM_MF_R(ByValIMedAsLong,ByValXnAsSingle,_
ByRefSpmMF()AsDouble,ByRefMedMFAsDouble)
'
'   Routine per il calcolo ricorsivo dello spettro mobile (sliding
'   spectrum) multi frequenza su NsSpm campioni.
'   Devono essere stati definiti, precedentemente, i coefficienti
'   z1_MF_1(), z1_MF_N() ed un vettore SmRE(0 To NsSpm) da usare come
'   registro a scorrimento dei campioni del segnale.
'   Ritorna anche il valore della media (o del valor efficace) mobile
'   degli ultimi NsSpm campioni.
'   In questa routine, per ragioni di velocita', le funzioni di numeri
'   complessi sono state sostituite con il loro sviluppo in linea.
'
DimK&
'
OnErrorResumeNext' Gestisce gli errori di troncamento nel calcolo di MedMF.
'
' SmRE() usato come buffer circolare:
Ic=((Ic+1)ModNsSpm1)
Kc=((Ic+1)ModNsSpm1)
SmRE(Ic)=CDbl(Xn)
'
ForK=0ToNFreqSPM_1
'XZ1_N = CMol(CCmp(SmRE(Kc), 0#), z1_MF_N)
Xz1_N.Re=SmRE(Kc)*z1_MF_N(K).Re
Xz1_N.Im=SmRE(Kc)*z1_MF_N(K).Im
'SnI = CDif(CCmp(SmRE(Ic), 0#), XZ1_N)
SnI.Re=SmRE(Ic)-Xz1_N.Re
SnI.Im=-Xz1_N.Im
'
'YZ1_1 = CMol(Sn_MF_1(K), z1_MF_1(K))
Yz1_1.Re=Sn_MF_1(K).Re*z1_MF_1(K).Re-Sn_MF_1(K).Im*z1_MF_1(K).Im
Yz1_1.Im=Sn_MF_1(K).Re*z1_MF_1(K).Im+Sn_MF_1(K).Im*z1_MF_1(K).Re
'Sn = CSom(SnI, YZ1_1)
Sn.Re=SnI.Re+Yz1_1.Re
Sn.Im=SnI.Im+Yz1_1.Im
Sn_MF_1(K)=Sn
'
'SpmMF(K) = CAbs(Sn) / NormSpm
SpmMF(K)=Sqr(Sn.Re*Sn.Re+Sn.Im*Sn.Im)/NormSpm
NextK
'
' Calcolo la media/valor efficace mobile:
If(NsSpm<IMed)Then
' Media mobile del valore assoluto del segnale:
'VMed = VMed + Abs(SmRE(Ic)) - Abs(SmRE(Kc))
'MedMF = VMed / CDbl(NsSpm)
'
' Valore efficace mobile:
SqRE(Ic)=SmRE(Ic)*SmRE(Ic)
VMed=VMed+SqRE(Ic)-SqRE(Kc)
MedMF=Sqr(VMed/CDbl(NsSpm))
'
Else
' Gestisco l' inizio del segnale:
If(IMed=1)ThenVMed=0#
'
' Media mobile del valore assoluto del segnale:
'VMed = VMed + Abs(SmRE(Ic))
'MedMF = VMed / CDbl(IMed)
'
' Valore efficace mobile:
SqRE(Ic)=SmRE(Ic)*SmRE(Ic)
VMed=VMed+SqRE(Ic)
MedMF=Sqr(VMed/CDbl(IMed))
EndIf
'
'
'
EndSub
PublicFunctionSPM_R(ByValXnAsLong)AsLong
'Public Function SPM_R(ByVal Xn As Single) As Single
'
'   Funzione per il calcolo ricorsivo dello spettro mobile
'   (sliding spectrum) su NsSpm campioni.
'   Devono essere stati definiti, precedentemente, i coefficienti
'   Z1_1, Z1_N ed un vettore SmRE(0 To NsSpm) da usare come
'   registro a scorrimento dei campioni del segnale.
'   In questa routine, per ragioni di velocita', le funzioni di numeri
'   complessi sono state sostituite con il loro sviluppo in linea.
'
'   Versione per filtro del trigger di AudioCardDSP (24/04/2009).
'
' SmRE() usato come buffer circolare:
Ic=((Ic+1)ModNsSpm1)
Kc=((Ic+1)ModNsSpm1)
SmRE(Ic)=Xn
'
' XZ1_N = CMol(CCmp(SmRE(NsSpm), 0#), Z1_N):
Xz1_N.Re=SmRE(Kc)*z1_N.Re
Xz1_N.Im=SmRE(Kc)*z1_N.Im
'
' SnI = CDif(CCmp(SmRE(0), 0#), XZ1_N):
SnI.Re=SmRE(Ic)-Xz1_N.Re
SnI.Im=-Xz1_N.Im
'
' Yz1_1 = CMol(Sn_1, z1_1):
Yz1_1.Re=Sn_1.Re*z1_1.Re-Sn_1.Im*z1_1.Im
Yz1_1.Im=Sn_1.Re*z1_1.Im+Sn_1.Im*z1_1.Re
'
' Sn = CSom(SnI, Yz1_1):
Sn.Re=SnI.Re+Yz1_1.Re
Sn.Im=SnI.Im+Yz1_1.Im
Sn_1=Sn
'
' SPM_R = CAbs(Sn) / NormSpm:
SPM_R=Sqr(Sn.Re*Sn.Re+Sn.Im*Sn.Im)/NormSpm
'
'
'
EndFunction
PublicFunctionMCorr_FT(D1()AsDouble,D2()AsDouble,_
ByValR1AsLong,ByValR2AsLong,_
OptionalByValbUnbiasedAsBoolean=False,_
OptionalByValbNoCCAsBoolean=False)AsDouble()
'
'   Espressione della mutua correlazione non circolare:
'   MCorr_FT(R) = (L / Ld) * IFFT((1 / L) * Coniugata(FFT(D1(I))) * FFT(D2(I)))
'    con: N1  = UBound(D1),  N2 = UBound(D2),
'        -N1 <= R1 <= 0,  0 <= R2 <= N2,  R1 <= R <= R2,
'         L  = MIN(N1 + 1,  N2 + 1),  Ld = MIN(N1 + R, N2) - MAX(0, R) + 1
'
'   Ritorna un vettore contenente la funzione di mutua correlazione
'   fra i dati in D1() e quelli in D2() calcolata su R1 --> R2  ritardi
'   [i.e. MCorr_FT(R1 To R2)].
'   I segnali D1() e D2() sono considerati finiti.
'   Se bUnbiased = True i valori della mutua correlazione vengono
'   corretti con 1 / (N - r).
'   Se bNoCC = True dai segnali viene eliminata la componente continua.
'
'   Il calcolo viene effettuato con FFT e IFFT.
'   Algoritmo tratto da: "Theory and Application of Digital
'   Signal Processing" di L. Rabiner e B. Gold. - pg. 403
'   e corretto con le equazioni di "Digital Time Series Analysis"
'   di R. K. Otnes, L. Enochson. - pg. 247, 248.
'
'   Ver. 18/10/2005 modificata per AudioCardDSP.
'
DimM&,M2_1&,N1&,N2&,r&
DimLNorm#,dd1#(),dd2#(),NBytes&
DimRe1#(),Im1#(),Re2#(),Im2#(),s#(),f#()
'
N1=UBound(D1)
N2=UBound(D2)
'
M=Ceil(Log((N1+N2+1))/Log2)
M2_1=(2^M)-1
'
' I dati devono avere media zero?
IfbNoCCThen
dd1()=EliminaCC(D1())
dd2()=EliminaCC(D2())
Else
dd1()=D1()
dd2()=D2()
EndIf
'
ReDimPreservedd1(0ToM2_1)' Aggiungo zeri per avere una potenza di 2.
ReDimPreservedd2(0ToM2_1)'""""""""
' Sposto i valori per comporre
' opportunamente il secondo segnale:
MoveMemorydd2(N1+1),dd2(0),8*(N2+1)
ZeroMemorydd2(0),8*(N1+1)
'    For R = N2 To 0 Step -1
'        dd2(N1 + R + 1) = dd2(R)
'        dd2(R) = 0#
'    Next R
'
' Calcolo la FFT dei due segnali:
FFT_D2dd1(),dd2(),Re1(),Im1(),Re2(),Im2(),M2_1+1
'
' Moltiplico la seconda trasformata
' per la coniugata della prima:
ReDims(0ToM2_1),f(0ToM2_1)' Uso S() e F() come vettori d' appoggio.
Forr=0ToM2_1
s(r)=(Re1(r)*Re2(r)+Im1(r)*Im2(r))' Parte reale.
f(r)=(Re1(r)*Im2(r)-Re2(r)*Im1(r))' Parte immaginaria.
Nextr
'
' Calcolo l' antitrasformata, corrispondente
' alla funzione di mutua correlazione:
IFFTs(),f(),Re1(),Im1()' Uso Re1() e Im1() come vettori d' appoggio.
'
' Sistemo i valori nell' ordine dei ritardi:
ReDimIm1(R1ToR2)' Uso Im1() come vettore d' appoggio.
NBytes=8*(R2-R1+1)' I valori > N1 + N2 + 1 sono nulli e/o simmetrici.
CopyMemoryIm1(R1),Re1(N1+R1+1),NBytes
'    For R = R1 To R2
'        Im1(R) = Re1(N1 + R + 1)
'    Next R
'
IfbUnbiasedThen
' Correzione dei valori della mutua
' correlazione con 1 / (N - r):
Forr=R1ToR2
' LNorm = MIN(N1 + R, N2) - MAX(0, R) + 1:
If(N1+r<N2)Then
LNorm=CDbl(N1+r+1)
Else
LNorm=CDbl(N2+1)
EndIf
If(0<r)ThenLNorm=LNorm-CDbl(r)
'
Im1(r)=Im1(r)/LNorm
Nextr
'
Else
' Correzione dei valori della mutua
' correlazione con 1 / N:
'LNorm = CDbl(MIN0(N1 + 1, N2 + 1))
If(N1<=N2)Then
LNorm=CDbl(N1+1)
Else
LNorm=CDbl(N2+1)
EndIf
Forr=R1ToR2
Im1(r)=Im1(r)/LNorm
Nextr
EndIf
'
MCorr_FT=Im1()
'
'
'
EndFunction
PublicFunctionMAutoCorr_FT(D1()AsDouble,_
ByValR1AsLong,ByValR2AsLong,_
OptionalByValbUnbiasedAsBoolean=True,_
OptionalByValbNoCCAsBoolean=True)AsDouble()
'
'   Espressione dell' auto correlazione non circolare:
'   MCorr_FT(R) = (L / Ld) * IFFT((1 / L) * Coniugata(FFT(D1(I))) * FFT(D1(I)))
'
'    con: D1(0 To N1_C - 1),
'         MM_C = Ceil(Log(CDbl(2 * N1_C - 1)) / Log2),
'         N_C = 2 ^ MM_C, NFre_C = N_C / 2,
'        -N1_C < R1 <= 0,  0 <= R2 < N1_C,  R1 <= R <= R2,
'         L  = N1_C,  Ld = N1_C - Abs(R)
'
'   Ritorna un vettore contenente la funzione di auto correlazione
'   dei dati in D1() calcolata su R1 --> R2  ritardi [i.e. MAutoCorr_FT(R1 To R2)].
'
'   I segnali D1() sono considerati finiti.
'   Se bUnbiased = True i valori dell' auto correlazione vengono
'   corretti con 1 / (N - |r|).
'   Se bNoCC = True dai segnali viene eliminata la componente continua.
'
'   Il calcolo viene effettuato con SFFTBF_Corr e SFFTBB_Corr e
'   deve essere preceduto da una chiamata alla Sub SFFTBI_Corr.
'
'   Algoritmo tratto da: "Theory and Application of Digital
'   Signal Processing" di L. Rabiner e B. Gold. - pg. 403
'   e corretto con le equazioni di "Digital Time Series Analysis"
'   di R. K. Otnes, L. Enochson. - pg. 247, 248.
'
'   Ver. 18/10/2005 modificata per AudioCardDSP.
'   Ver. 22/05/2007 con SFFTBF_Corr e SFFTBB_Corr.
'
Dimr&,NBytes&
Dimdd1#(),Sxx#
DimCorr#(),LNorm#
'
' I dati devono avere media zero?
IfbNoCCThen
dd1()=EliminaCC(D1())
Else
dd1()=D1()
EndIf
'
ReDimPreservedd1(0ToN_C-1)' Aggiungo zeri per avere una potenza di 2.
'
' Calcolo la FFT del segnale:
SFFTBF_Corrdd1(),Re1_C(),Im1_C()
'
' (A) - Calcolo la trasformata del segnale
'       ritardato di N1_C campioni:
'For R = 0 To NFre_C
'    Re2_C(R) = (Re1_C(R) * WnRe(R) - Im1_C(R) * WnIm(R))    ' Parte reale.
'    Im2_C(R) = (WnRe(R) * Im1_C(R) + Re1_C(R) * WnIm(R))    ' Parte immaginaria.
'Next R
'
' (B) - Moltiplico la seconda trasformata
'       per la coniugata della prima:
'For R = 0 To NFre_C
'    S(R) = (Re1_C(R) * Re2_C(R) + Im1_C(R) * Im2_C(R))  ' Parte reale.
'    F(R) = (Re1_C(R) * Im2_C(R) - Re2_C(R) * Im1_C(R))  ' Parte immaginaria.
'Next R
'
' Compatto i calcoli (A) e (B) precedenti per
' aumentarne la velocita' di esecuzione:
Forr=0ToNFre_C
Sxx=Re1_C(r)*Re1_C(r)+Im1_C(r)*Im1_C(r)
s(r)=Sxx*WnRe(r)' Parte reale.
f(r)=Sxx*WnIm(r)' Parte immaginaria.
Nextr
'
' Calcolo l' antitrasformata, corrispondente
' alla funzione di mutua correlazione:
SFFTBB_Corrs(),f(),dd1()' Uso dd1() come vettore d' appoggio.
'
' Sistemo i valori nell' ordine dei ritardi:
ReDimCorr(R1ToR2)' Uso Corr() come vettore d' appoggio.
NBytes=8*(R2-R1+1)' I valori > 2 * N1_C - 1 sono nulli e/o simmetrici.
CopyMemoryCorr(R1),dd1(N1_C+R1),NBytes
'
IfbUnbiasedThen
' Correzione dei valori della mutua
' correlazione con 1 / (N - |r|):
Forr=R1ToR2
LNorm=CDbl(N1_C-Abs(r))
Corr(r)=Corr(r)/LNorm
Nextr
'
Else
' Correzione dei valori della mutua
' correlazione con 1 / N:
LNorm=CDbl(N1_C)
Forr=R1ToR2
Corr(r)=Corr(r)/LNorm
Nextr
EndIf
'
MAutoCorr_FT=Corr()
'
'
'
EndFunction
PublicFunctionMMutuaCorr_FT(D1()AsDouble,D2()AsDouble,_
ByValR1AsLong,ByValR2AsLong,_
OptionalByValbUnbiasedAsBoolean=False,_
OptionalByValbNoCCAsBoolean=False)AsDouble()
'
'   Espressione della mutua correlazione non circolare:
'   MMutuaCorr_FT(R) = (L / Ld) * IFFT((1 / L) * Coniugata(FFT(D1(I))) * FFT(D2(I)))
'
'    con: D1(0 To N1_C - 1), D2(0 To N2_C - 1),
'         MM_C = Ceil(Log(CDbl(N1_C + N2_C - 1)) / Log2),
'         N_C = 2 ^ MM_C, NFre_C = N_C / 2,
'        -N1_C < R1 <= 0,  0 <= R2 < N2_C,  R1 <= R <= R2,
'         L  = MIN(N1_C,  N2_C),  Ld = MIN(N1_C + R, N2_C) - MAX(0, R)
'
'   Ritorna un vettore contenente la funzione di mutua correlazione
'   fra i dati in D1() e quelli in D2() calcolata su R1 --> R2  ritardi
'   [i.e. MAutoCorr_FT(R1 To R2)].
'
'   I segnali D1() e D2() sono considerati finiti.
'   Se bUnbiased = True i valori dell' auto correlazione vengono
'   corretti con 1 / (N - |r|).
'   Se bNoCC = True dai segnali viene eliminata la componente continua.
'
'   Il calcolo viene effettuato con SFFTBF_Corr e SFFTBB_Corr e
'   deve essere preceduto da una chiamata alla Sub SFFTBI_Corr.
'
'   Algoritmo tratto da: "Theory and Application of Digital
'   Signal Processing" di L. Rabiner e B. Gold. - pg. 403
'   e corretto con le equazioni di "Digital Time Series Analysis"
'   di R. K. Otnes, L. Enochson. - pg. 247, 248.
'
'   Ver. 18/10/2005 modificata per AudioCardDSP.
'   Ver. 22/05/2007 con SFFTBF_Corr e SFFTBB_Corr.
'
'
Dimr&,NBytes&
Dimdd1#(),dd2#()
DimCorr#(),LNorm#
'
' I dati devono avere media zero?
IfbNoCCThen
dd1()=EliminaCC(D1())
dd2()=EliminaCC(D2())
Else
dd1()=D1()
dd2()=D2()
EndIf
'
ReDimPreservedd1(0ToN_C-1)' Aggiungo zeri per avere una potenza di 2.
ReDimPreservedd2(0ToN_C-1)' Aggiungo zeri per avere una potenza di 2.
' Sposto i valori per comporre
' opportunamente il secondo segnale
' ritardato di N1_C campioni:
MoveMemorydd2(N1_C),dd2(0),8*N2_C
ZeroMemorydd2(0),8*N1_C
'
' Calcolo le FFT dei segnali:
SFFTBF_Corrdd1(),Re1_C(),Im1_C()
SFFTBF_Corrdd2(),Re2_C(),Im2_C()
'
' Moltiplico la seconda trasformata
' per la coniugata della prima:
Forr=0ToNFre_C
s(r)=(Re1_C(r)*Re2_C(r)+Im1_C(r)*Im2_C(r))' Parte reale.
f(r)=(Re1_C(r)*Im2_C(r)-Re2_C(r)*Im1_C(r))' Parte immaginaria.
Nextr
'
' Calcolo l' antitrasformata, corrispondente
' alla funzione di mutua correlazione:
SFFTBB_Corrs(),f(),dd1()' Uso dd1() come vettore d' appoggio.
'
' Sistemo i valori nell' ordine dei ritardi:
ReDimCorr(R1ToR2)' Uso Corr() come vettore d' appoggio.
NBytes=8*(R2-R1+1)' I valori > N1_C + N2_C - 1 sono nulli e/o simmetrici.
CopyMemoryCorr(R1),dd1(N1_C+R1),NBytes
'
IfbUnbiasedThen
' Correzione dei valori della mutua
' correlazione con 1 / (N - |r|):
Forr=R1ToR2
' LNorm = MIN0(N1_C + R, N2_C) - MAX0(0, R):
If(N1_C+r<N2_C)Then
LNorm=CDbl(N1_C+r)
Else
LNorm=CDbl(N2_C)
EndIf
If(0<r)ThenLNorm=LNorm-CDbl(r)
'
Corr(r)=Corr(r)/LNorm
Nextr
'
Else
' Correzione dei valori della mutua
' correlazione con 1 / N:
' LNorm = CDbl(MIN0(N1_C, N2_C)):
If(N1_C<=N2_C)Then
LNorm=CDbl(N1_C)
Else
LNorm=CDbl(N2_C)
EndIf
'
Forr=R1ToR2
Corr(r)=Corr(r)/LNorm
Nextr
EndIf
'
MMutuaCorr_FT=Corr()
'
'
'
EndFunction
PublicSubFFT_D2(D1()AsDouble,D2()AsDouble,_
R1()AsDouble,X1()AsDouble,R2()AsDouble,X2()AsDouble,ByRefNVALAsLong)
'
'   Definizioni:
'
'   FFT = Fast Fourier Transform.
'
'   Entra con:
'       D1()  = Vettore dei dati Reali del primo   Segnale(t).
'       D2()  = Vettore dei dati Reali del secondo Segnale(t).
'       NVAL  = Numero max. dei dati in D1(), D2() da usare.
'
'   Esce  con:
'       R1()  = Vettore dei valori Reali      della Trasformata(f) del primo   segnale.
'       X1()  = Vettore dei valori Immaginari della Trasformata(f) del primo   segnale.
'       R2()  = Vettore dei valori Reali      della Trasformata(f) del secondo segnale.
'       X2()  = Vettore dei valori Immaginari della Trasformata(f) del secondo segnale.
'       NVAL  = Numero  dei dati usati        dalla Trasformata(f).
'       NFRE  = Numero  dei valori di Frequenza calcolati.
'
'   Calcola, contemporaneamente, le trasformate di due segnali
'   reali definiti in D1(0 To NVAL - 1) e D2(0 To NVAL - 1).
'
'   I valori delle Trasformate in R1(), X1(), R2(), X2() NON vengono
'   normalizzati sulla lunghezza del Segnale 2^M.
'
'   I vettori R1(), X1() e R2(), X2() sono dimensionati in questa routine.
'   Gli NN dati nei vettori sono organizzati come Vettore(0 To NN - 1).
'
'   Tradotta in Basic da: "Theory and Application of Digital
'"Theory and Application of Digital Signal Processing"
'    di L. Rabiner e B. Gold. - pg. 367.
'   e con le formule di:
'"Digital Time Series Analysis"
'    di R. Otnes e L. Enochson - pg. 175.
'
'   Ver. 18/10/2005 modificata per AudioCardDSP.
'
DimM&,I&,NMN1&,NFRE&,J&,K&,L&,LE&,LE1&,IP&,JF&,NBytes&
DimTSwap#,Ur#,Ui#,wr#,wi#,Tr#,Ti#
'
M=Int(Log(CDbl(NVAL)+0.5)/Log2)
NVAL=2^M
NFRE=NVAL/2
NMN1=NVAL-1
'
ReDimRe#(0ToNVAL-1),Im#(0ToNVAL-1)
ReDimR1(0ToNVAL-1),R2(0ToNVAL-1),X1(0ToNVAL-1),X2(0ToNVAL-1)
'
' Compongo i vettori Re(), Im() da trasformare
' con i dati reali in ingresso:
NBytes=8*NVAL
CopyMemoryRe(0),D1(0),NBytes
CopyMemoryIm(0),D2(0),NBytes
'    For I = 0 To NVAL - 1
'        Re(I) = D1(I)
'        Im(I) = D2(I)
'    Next I
'
J=0
ForI=0ToNMN1-1
If(I<J)Then
' DSWAP Re(J), Re(I):
TSwap=Re(J)
Re(J)=Re(I)
Re(I)=TSwap
' DSWAP Im(J), Im(I)
TSwap=Im(J)
Im(J)=Im(I)
Im(I)=TSwap
EndIf
K=NFRE
DoWhile(K-1<J)
J=J-K
K=K/2
Loop
J=J+K
NextI
'
ForL=1ToM
LE=2^L
LE1=LE/2
Ur=1#
Ui=0#
wr=Cos(PI/LE1)
wi=Sin(PI/LE1)
ForJ=0ToLE1-1
ForI=JToNVAL-1StepLE
IP=I+LE1
Tr=Re(IP)*Ur-Im(IP)*Ui
Ti=Re(IP)*Ui+Im(IP)*Ur
Re(IP)=Re(I)-Tr
Im(IP)=Im(I)-Ti
Re(I)=Re(I)+Tr
Im(I)=Im(I)+Ti
NextI
Tr=Ur
Ti=Ui
Ur=Tr*wr-Ti*wi
Ui=Tr*wi+Ti*wr
NextJ
NextL
'
' Calcolo delle parti reali ed immaginarie delle trasformate:
R1(0)=Re(0)
X1(0)=0#
R2(0)=Im(0)
X2(0)=0#
'
ForJF=1ToNVAL-1
R1(JF)=(Re(JF)+Re(NVAL-JF))/2#
X1(JF)=(Im(JF)-Im(NVAL-JF))/2#
R2(JF)=(Im(JF)+Im(NVAL-JF))/2#
X2(JF)=(Re(NVAL-JF)-Re(JF))/2#
NextJF
'
'
'
EndSub
PublicSubIFFT(r()AsDouble,X()AsDouble,Dr()AsDouble,dx()AsDouble,_
OptionalByRefNVALAsLong)
'
'   Definizioni:
'
'   IFFT = Inverse Fast Fourier Transform.
'
'   Entra con:
'       R()  = Vettore dei valori Reali      della Trasformata(f).
'       X()  = Vettore dei valori Immaginari della Trasformata(f).
'
'   Esce  con:
'       Dr() = Vettore dei dati Reali      del Segnale(t).
'       Dx() = Vettore dei dati Immaginari del Segnale(t).
'       NVAL = Numero  dei dati usati per l' antitrasformata.
'
'   I vettori Dr(), Dx() sono dimensionati in questa routine.
'   Gli NN dati nei vettori sono organizzati come Vettore(0 To NN - 1).
'
'   Algoritmo tratto da: "Theory and Application of Digital
'   Signal Processing" di L. Rabiner e B. Gold. - pg. 371.
'
DimNFRE&,M&,I&,NMN1&,J&
DimK&,L&,LE&,LE1&,IP&,JF&
DimUr#,Ui#,wr#,wi#,Tr#,Ti#
'
NVAL=UBound(r)+1
M=Int(Log(CDbl(NVAL)+0.5)/Log2)
NVAL=2^M
NFRE=NVAL/2
NMN1=NVAL-1
'
ReDimDr(0ToNVAL-1),dx(0ToNVAL-1),d(0ToNVAL-1)
'
' Se non si vogliono sfruttare le proprieta'
'"transform-in-place" di questa implementazione:
ForI=0ToNVAL-1
Dr(I)=r(I)/CDbl(NVAL)
dx(I)=-X(I)/CDbl(NVAL)
NextI
'
J=0
ForI=0ToNMN1-1
If(I<J)Then
DSWAPDr(J),Dr(I)
DSWAPdx(J),dx(I)
EndIf
K=NFRE
DoWhile(K-1<J)
J=J-K
K=K/2
Loop
J=J+K
NextI
'
ForL=1ToM
LE=2^L
LE1=LE/2
Ur=1#
Ui=0#
wr=Cos(PI/LE1)
wi=Sin(PI/LE1)
ForJ=0ToLE1-1
ForI=JToNVAL-1StepLE
IP=I+LE1
Tr=Dr(IP)*Ur-dx(IP)*Ui
Ti=Dr(IP)*Ui+dx(IP)*Ur
Dr(IP)=Dr(I)-Tr
dx(IP)=dx(I)-Ti
Dr(I)=Dr(I)+Tr
dx(I)=dx(I)+Ti
NextI
Tr=Ur
Ti=Ui
Ur=Tr*wr-Ti*wi
Ui=Tr*wi+Ti*wr
NextJ
NextL
'
'
'
EndSub
PublicFunctionMCorr(D1()AsDouble,D2()AsDouble,_
ByValR1AsLong,ByValR2AsLong,_
OptionalByValbUnbiasedAsBoolean=False,_
OptionalByValbNoCCAsBoolean=False)AsDouble()
'
'   Espressione della mutua correlazione non circolare:
'                                    I2
'   MCorr(R) = (1 / (I2 - I1 + 1)) * Som(D1(I) * D2(I + R))   con:  N1  = UBound(D1)
'                                    I=I1                      "    N2  = UBound(D2)
'"   -N1 <= R1 <  R2
'"    R1  < R2 <= N2
'"    R1 <= R  <= R2
'"    I1  = MAX(0, -R)
'"    I2  = MIN(N1, N2 - R)
'
'   Ritorna un vettore contenente la funzione di mutua correlazione
'   fra i dati in D1() e quelli in D2() calcolata su R1 --> R2  ritardi
'   [i.e. MCorr(R1 To R2)].
'   Il segnale D2() e' considerato finito e costituito da UBound(D2) + 1
'   campioni.
'   Se bUnbiased = True i valori della mutua correlazione vengono
'   corretti con 1 / (N - r).
'   Se bNoCC = True dai segnali viene eliminata la componente continua.
'
'   Il calcolo viene effettuato per convoluzione diretta
'   e corretto con le equazioni di "Digital Time Series Analysis"
'   di R. K. Otnes, L. Enochson. - pg. 247.
'
'   Ver. 16/10/2005 modificata per AudioCardDSP.
'
DimI&,I1&,I2&,N1&,N2&,r&', R1&, R2&
DimLNorm#,dd1#(),dd2#()
'
N1=UBound(D1)
N2=UBound(D2)
'
ReDimRR#(R1ToR2)
ReDimMCorr(R1ToR2)
LNorm=CDbl(MIN0(N1+1,N2+1))
'
' I dati devono avere media zero?
IfbNoCCThen
dd1()=EliminaCC(D1())
dd2()=EliminaCC(D2())
Else
dd1()=D1()
dd2()=D2()
EndIf
'
' Calcolo la funzione di mutua correlazione:
Forr=R1ToR2
I1=MAX0(0,-r)
I2=MIN0(N1,N2-r)
ForI=I1ToI2
RR(r)=RR(r)+dd1(I)*dd2(I+r)
NextI
'
IfbUnbiasedThen
RR(r)=RR(r)/CDbl(I2-I1+1)
Else
RR(r)=RR(r)/LNorm
EndIf
Nextr
'
MCorr=RR()
'
'
'
EndFunction
PublicFunctionIIR(ByValVInAsSingle)AsSingle
'
'   Funzione di filtrazione IIR dei segnali.
'   Devono essere state definite, precedentemente, le matrici
'   Ac(0 To NK, 1 To NCel) e Bc(0 To NK, 1 To NCel) contenenti
'   i coefficienti del filtro ed una matrice W(0 To NK, 1 To NCel)
'   da usare come registro a scorrimento dei campioni da filtrare.
'
'   Codice tradotto ed adattato dal FORTRAN di:
'"Digital Filters and their Applications"
'     di V. Cappellini, A. G. Constantinides, P. Emiliani.
'     pg. 373.
'
'   Routine modificata per strumenti di misura.
'   -------------------------------------------
'
DimC&,K&,Y!
'
Y=VIn
ForC=1ToNCel
w(0,C)=Y
Y=0!
ForK=NKTo1Step-1
w(0,C)=w(0,C)-Bc(K,C)*w(K,C)
Y=Y+Ac(K,C)*w(K,C)
w(K,C)=w(K-1,C)
NextK
Y=Y+Ac(0,C)*w(0,C)
NextC
'
IIR=Y
'
'
'
EndFunction
PublicFunctionFIR(ByValVInAsSingle)AsSingle
'
'   Funzione di filtrazione FIR dei segnali.
'   Devono essere stati definiti, precedentemente, un vettore
'   Hc(0 To NCoeff - 1) contenente gli NCoeff coefficienti del
'   filtro ed un vettore SRE(-1 To NCoeff - 1) da usare come
'   registro a scorrimento dei campioni da filtrare.
'
'   Codice tradotto ed adattato dal FORTRAN di:
'"Digital Filters and their Applications"
'     di V. Cappellini, A. G. Constantinides, P. Emiliani.
'     pg. 371.
'
'   Routine modificata per strumenti di misura.
'   -------------------------------------------
'
DimK&,VOut!
'
SRE(-1)=VIn
ForK=UBound(SRE)To0Step-1
SRE(K)=SRE(K-1)
VOut=VOut+SRE(K)*Hc(K)
NextK
'
FIR=VOut
'
'
'
EndFunction
PublicSubSFFTBB(ByValNAsLong,ByValNFREAsLong,_
Re()AsDouble,Im()AsDouble,ByRefd()AsDouble)
'
'   SFFTBB( X, N, MM, S1, C1, S3, C3, ITAB )
'
'   A real-valued, in place, split-radix IFFT program
'   Hermitian symmetric input and real output in array X
'   Length is N = 2 ** MM
'   Decimation-in-frequency, cos/sin in second loop with table look-up
'   Input order:
'    [ Re(0), Re(1), ..., Re(N/2), Im(N/2-1), ..., Im(1) ]
'
'   S1 - array of sin() table (length >= N/8-1)
'   C1 - array of cos() table (length >= N/8-1)
'   S3 - array of sin() table (length >= N/8-1)
'   C3 - array of cos() table (length >= N/8-1)
'   ITAB - integer bit reversal table (length >= sqrt(2n) )
'
'   The initialization routine SFFTBI must be called prior to calling
'   this routine.  SFFTBI need not be called again unless N changes.
'
'   Original code (IRVFFT) written by H.V. Sorensen,
'                                     Rice University, Oct. 1985
'
'   Modifications made by Steve Kifowit, 26 June 1997
'    -- table look-up of sines and cosines
'    -- incorporation of bit reversal table
'    -- quick return
'
'   Tradotta dal FORTRAN e modificata da F. Languasco 15/10/2005.
'
'   Entra con:
'       N     = Numero max. di dati in D() da calcolare.
'       NFRE  = Numero dei valori di Frequenza nei vettori Re() e Im().
'       Re()  = Vettore dei valori Reali      della Trasformata(f).
'       Im()  = Vettore dei valori Immaginari della Trasformata(f).
'
'   Esce  con:
'       D()   = Vettore dei valori Reali del Segnale(t), ridimensionato
'               in questa routine.
'
'   Gli NFRE + 1 dati nei vettori Re() e Im() sono organizzati come
'   Vettore(0 To NFRE); gli N dati nel vettore D() sono organizzati
'   come D(0 To N - 1).
'
DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
DimN1&,N2&,N4&,N8&,NN&,It&
DimXT#,R1#,t1#,T2#,T3#,T4#,T5#
DimCC1#,SS1#,CC3#,SS3#
ReDimd#(0ToN-1)
'
If(N=1)ThenExitSub
'
' Sistemo i valori dei vettori Re(), Im() in D1():
'    For I = 0 To NFre
'        D1(I + 1) = Re(I)
'    Next I
CopyMemoryD1(1),Re(0),8*(NFRE+1)
ForI=1ToNFRE-1
D1(N-I+1)=Im(I)
NextI
'
N2=2*N
NN=1
ForK=1ToMM-1
Ic=0
ID=N2
N2=N2/2
N4=N2/4
N8=N4/2
17ForI=IcToN-1StepID
I1=I+1
I2=I1+N4
I3=I2+N4
I4=I3+N4
t1=D1(I1)-D1(I3)
D1(I1)=D1(I1)+D1(I3)
D1(I2)=2*D1(I2)
D1(I3)=t1-2*D1(I4)
D1(I4)=t1+2*D1(I4)
If(N4=1)ThenGoTo15
I1=I1+N8
I2=I2+N8
I3=I3+N8
I4=I4+N8
t1=(D1(I2)-D1(I1))/Sqr2
T2=(D1(I4)+D1(I3))/Sqr2
D1(I1)=D1(I1)+D1(I2)
D1(I2)=D1(I4)-D1(I3)
D1(I3)=2*(-T2-t1)
D1(I4)=2*(-T2+t1)
15' CONTINUE
NextI
Ic=2*ID-N2
ID=4*ID
If(Ic<N-1)ThenGoTo17
ForJ=2ToN8
It=(J-1)*NN
CC1=C1(It)
SS1=S1(It)
CC3=C3(It)
SS3=S3(It)
Ic=0
ID=2*N2
40ForI=IcToN-1StepID
I1=I+J
I2=I1+N4
I3=I2+N4
I4=I3+N4
I5=I+N4-J+2
I6=I5+N4
I7=I6+N4
I8=I7+N4
t1=D1(I1)-D1(I6)
D1(I1)=D1(I1)+D1(I6)
T2=D1(I5)-D1(I2)
D1(I5)=D1(I2)+D1(I5)
T3=D1(I8)+D1(I3)
D1(I6)=D1(I8)-D1(I3)
T4=D1(I4)+D1(I7)
D1(I2)=D1(I4)-D1(I7)
T5=t1-T4
t1=t1+T4
T4=T2-T3
T2=T2+T3
D1(I3)=T5*CC1+T4*SS1
D1(I7)=-T4*CC1+T5*SS1
D1(I4)=t1*CC3-T2*SS3
D1(I8)=T2*CC3+t1*SS3
30' CONTINUE
NextI
Ic=2*ID-N2
ID=4*ID
If(Ic<N-1)ThenGoTo40
20' CONTINUE
NextJ
NN=2*NN
NextK
'
Ic=1
ID=4
70ForI0=IcToNStepID
I1=I0+1
R1=D1(I0)
D1(I0)=R1+D1(I1)
D1(I1)=R1-D1(I1)
60' CONTINUE
NextI0
Ic=2*ID-1
ID=4*ID
If(Ic<N)ThenGoTo70
'
N1=ITAB(1)
ForK=2ToN1
I0=N1*ITAB(K)+1
I=K
J=I0
ForIt=2ToITAB(K)+1
XT=D1(I)
D1(I)=D1(J)
D1(J)=XT
I=I+N1
J=I0+ITAB(It)
101' CONTINUE
NextIt
100' CONTINUE
NextK
'
ForI=1ToN
D1(I)=D1(I)/N
99' CONTINUE
NextI
'
' Sposto i dati calcolati nel vettore D():
CopyMemoryd(0),D1(1),8*N
'
' ... End of subroutine SFFTBB ...
'
EndSub
PublicSubSFFTBB_Corr(Re_C()AsDouble,Im_C()AsDouble,ByRefd()AsDouble)
'
'   SFFTBB( X, N_C, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C )
'
'   A real-valued, in place, split-radix IFFT program
'   Hermitian symmetric input and real output in array X
'   Length is N_C = 2 ** MM_C
'   Decimation-in-frequency, cos/sin in second loop with table look-up
'   Input order:
'    [ Re_C(0), Re_C(1), ..., Re_C(N_C/2), Im_C(N_C/2-1), ..., Im_C(1) ]
'
'   S1_C   - array of sin() table (length >= N_C/8-1)
'   C1_C   - array of cos() table (length >= N_C/8-1)
'   S3_C   - array of sin() table (length >= N_C/8-1)
'   C3_C   - array of cos() table (length >= N_C/8-1)
'   ITAB_C - integer bit reversal table (length >= sqrt(2n) )
'
'   The initialization routine SFFTBI_Corr must be called prior to calling
'   this routine.  SFFTBI_Corr need not be called again unless  N1_C or
'   N2_C change.
'
'   Original code (IRVFFT) written by H.V. Sorensen,
'                                     Rice University, Oct. 1985
'
'   Modifications made by Steve Kifowit, 26 June 1997
'    -- table look-up of sines and cosines
'    -- incorporation of bit reversal table
'    -- quick return
'
'   Tradotta dal FORTRAN e modificata da F. Languasco 15/10/2005.
'
'   Entra con:
'       N_C     = Numero max. di dati in D() da calcolare.
'       NFre_C  = Numero dei valori di Frequenza nei vettori Re_C() e Im_C().
'       Re_C()  = Vettore dei valori Reali      della Trasformata(f).
'       Im_C()  = Vettore dei valori Immaginari della Trasformata(f).
'
'   Esce  con:
'       D()     = Vettore dei valori Reali del Segnale(t), ridimensionato
'                 in questa routine.
'
'   Gli NFre_C + 1 dati nei vettori Re_C() e Im_C() sono organizzati come
'   Vettore(0 To NFre_C); gli N_C dati nel vettore D() sono organizzati
'   come D(0 To N_C - 1).
'
'   Ver: 22/05/2007 per MAutoCorr_FT e MMutuaCorr_FT.
'
DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
DimN1&,N2&,N4&,N8&,NN&,It&
DimXT#,R1#,t1#,T2#,T3#,T4#,T5#
DimCC1#,SS1#,CC3#,SS3#
ReDimd#(0ToN_C-1)
'
If(N_C=1)ThenExitSub
'
' Sistemo i valori dei vettori Re_C(), Im_C() in D1_C():
CopyMemoryD1_C(1),Re_C(0),8*(NFre_C+1)
ForI=1ToNFre_C-1
D1_C(N_C-I+1)=Im_C(I)
NextI
'
N2=2*N_C
NN=1
ForK=1ToMM_C-1
Ic=0
ID=N2
N2=N2/2
N4=N2/4
N8=N4/2
17ForI=IcToN_C-1StepID
I1=I+1
I2=I1+N4
I3=I2+N4
I4=I3+N4
t1=D1_C(I1)-D1_C(I3)
D1_C(I1)=D1_C(I1)+D1_C(I3)
D1_C(I2)=2*D1_C(I2)
D1_C(I3)=t1-2*D1_C(I4)
D1_C(I4)=t1+2*D1_C(I4)
If(N4=1)ThenGoTo15
I1=I1+N8
I2=I2+N8
I3=I3+N8
I4=I4+N8
t1=(D1_C(I2)-D1_C(I1))/Sqr2
T2=(D1_C(I4)+D1_C(I3))/Sqr2
D1_C(I1)=D1_C(I1)+D1_C(I2)
D1_C(I2)=D1_C(I4)-D1_C(I3)
D1_C(I3)=2*(-T2-t1)
D1_C(I4)=2*(-T2+t1)
15' CONTINUE
NextI
'
Ic=2*ID-N2
ID=4*ID
If(Ic<N_C-1)ThenGoTo17
'
ForJ=2ToN8
It=(J-1)*NN
CC1=C1_C(It)
SS1=S1_C(It)
CC3=C3_C(It)
SS3=S3_C(It)
Ic=0
ID=2*N2
40ForI=IcToN_C-1StepID
I1=I+J
I2=I1+N4
I3=I2+N4
I4=I3+N4
I5=I+N4-J+2
I6=I5+N4
I7=I6+N4
I8=I7+N4
t1=D1_C(I1)-D1_C(I6)
D1_C(I1)=D1_C(I1)+D1_C(I6)
T2=D1_C(I5)-D1_C(I2)
D1_C(I5)=D1_C(I2)+D1_C(I5)
T3=D1_C(I8)+D1_C(I3)
D1_C(I6)=D1_C(I8)-D1_C(I3)
T4=D1_C(I4)+D1_C(I7)
D1_C(I2)=D1_C(I4)-D1_C(I7)
T5=t1-T4
t1=t1+T4
T4=T2-T3
T2=T2+T3
D1_C(I3)=T5*CC1+T4*SS1
D1_C(I7)=-T4*CC1+T5*SS1
D1_C(I4)=t1*CC3-T2*SS3
D1_C(I8)=T2*CC3+t1*SS3
30' CONTINUE
NextI
'
Ic=2*ID-N2
ID=4*ID
If(Ic<N_C-1)ThenGoTo40
20' CONTINUE
NextJ
NN=2*NN
NextK
'
Ic=1
ID=4
70ForI0=IcToN_CStepID
I1=I0+1
R1=D1_C(I0)
D1_C(I0)=R1+D1_C(I1)
D1_C(I1)=R1-D1_C(I1)
60' CONTINUE
NextI0
'
Ic=2*ID-1
ID=4*ID
If(Ic<N_C)ThenGoTo70
'
N1=ITAB_C(1)
ForK=2ToN1
I0=N1*ITAB_C(K)+1
I=K
J=I0
ForIt=2ToITAB_C(K)+1
XT=D1_C(I)
D1_C(I)=D1_C(J)
D1_C(J)=XT
I=I+N1
J=I0+ITAB_C(It)
101' CONTINUE
NextIt
100' CONTINUE
NextK
'
ForI=1ToN_C
D1_C(I)=D1_C(I)/N_C
99' CONTINUE
NextI
'
' Sposto i dati calcolati nel vettore D():
CopyMemoryd(0),D1_C(1),8*N_C
'
' ... End of subroutine SFFTBB ...
'
EndSub
PublicFunctionSintesiFIR_WM(ByValTipo$,ByValNFiltAsLong,_
ByValF1AsDouble,ByValF2AsDouble,ByValWNome$,ByValParAsDouble)AsBoolean
'
'   Sintesi del filtro con Window Method.
'
'   Routine modificata per strumenti di misura.
'   -------------------------------------------
'
'   Parametri in ingresso.
'    Tipo$:     Tipo di filtro:
'"Low Pass"
'"High Pass"
'"Band Pass"
'"Band Stop"
'"Differentiator"
'"Hilbert Trans."
'    NFilt:     Numero di Coefficienti del filtro.
'    F1:        Prima   Frequenza di Taglio (0 <= F1 < Fs/2).
'    F2:        Seconda Frequenza di Taglio (F1 < F2 <= Fs/2).
'    WNome$:    Nome del tipo di Window desiderato (vedi Function WinTipi()).
'    Par:       Parametro per certi tipi di Windows.
'
'   I coefficienti del filtro vengono calcolati
'   nel vettore Hc(0 To NFilt - 1).
'
DimI&,K&,KK&,NOdd&,NFilt1&
DimAA#,Ak#,Af1#,Af2#,Den#
ReDimHc(0ToNFilt-1),SRE(-1ToNFilt-1)
'
OnErrorGoToSintesiFIR_WM_ERR
'
NOdd=NFiltMod2
NFilt1=Int(NFilt/2)
AA=0.5*(1#-CDbl(NOdd))
'
WF()=WinProf(WNome$,NFilt,Par)
'
'       Impulse response evaluation
'       ---------------------------
'
IfNOdd=1Then
SelectCaseTipo$
Case"Low Pass"
Hc(NFilt1)=2#*F1
Case"High Pass"
Hc(NFilt1)=1#-2#*F1
Case"Band Pass"
Hc(NFilt1)=2#*(F2-F1)
Case"Band Stop"
Hc(NFilt1)=1#-2#*(F2-F1)
Case"Differentiator"
Hc(NFilt1)=0#
Case"Hilbert Trans."
Hc(NFilt1)=0#
EndSelect
EndIf
'
ForI=1ToNFilt1
K=NFilt1-I
Ak=CDbl(I)-AA
Af1=PI2*Ak*F1
Af2=PI2*Ak*F2
Den=PI*Ak
'
SelectCaseTipo$
Case"Low Pass"
Hc(K)=Sin(Af1)/Den
'
Case"High Pass"
Hc(K)=(Sin(PI*Ak)-Sin(Af1))/Den
'
Case"Band Pass"
Hc(K)=(Sin(Af2)-Sin(Af1))/Den
'
Case"Band Stop"
Hc(K)=(Sin(PI*Ak)-Sin(Af2)+Sin(Af1))/Den
'
Case"Differentiator"
Hc(K)=-(Sin(Af1)-Af1*Cos(Af1))/(Den*Den)
'
Case"Hilbert Trans."
Hc(K)=-(Cos(Af1)-Cos(Af2))/Den
EndSelect
'
' Windowing:
Hc(K)=Hc(K)*WF(K)
NextI
'
'
ForK=0ToNFilt1-1
KK=NFilt-1-K
Hc(KK)=Switch(Tipo$="Differentiator",-Hc(K),_
Tipo$="Hilbert Trans.",-Hc(K),_
True,Hc(K))
NextK
'
'
SintesiFIR_WM_ERR:
SintesiFIR_WM=(Err.Number=0)
If(Err.Number<>0)Then
DimM$
M$=FiltroErrFIR$&vbNewLine&vbNewLine
M$=M$&"Errore "&Str$(Err.Number)&vbNewLine
M$=M$&Err.Description
MsgBoxM$,vbCritical," modDSP: SintesiFIR_WM"
EndIf
'
'
'
EndFunction
PublicFunctionSintesiIIR_BT(ByValTrans$,ByValProty$,ByRefFCtAsDouble,_
OptionalByValFAtAsDouble,OptionalByValAttAsDouble,OptionalByValRipAsDouble,_
OptionalByValF1AsDouble,OptionalByValF2AsDouble,_
OptionalByValqAsDouble,OptionalByRefAttTotAsDouble,_
OptionalByRefAlfaAsDouble)AsBoolean
'
'   Sintesi del filtro richiesto con il metodo
'   di Trasformazione Bilineare.
'
'   Routine modificata per strumenti di misura.
'   -------------------------------------------
'
'   Parametri in ingresso.
'    Trans$:    Tipo di Trasformazione richiesta:
'"No Transformation"               JBT = 0
'"Low Pass -> Low Pass"            JBT = 1
'"Low Pass -> High Pass"           JBT = 2
'"Low Pass -> Band Pass"           JBT = 3
'"Low Pass -> Band Stop"           JBT = 4
'               Filtri elementari:
'"RC Type Low Pass Filter"         JBT = 5
'"RC Type High Pass Filter"        JBT = 6
'"Resonator"                       JBT = 7
'"Notch Filter"                    JBT = 8
'"U(t) = a·I(t) + (1-a)·U(t-1)"    JBT = 9
'    Proty$:    Tipo di prototipo Passa Basso:
'"Butterworth"
'"Chebyshev"
'    FCt:       Frequenza di taglio (con atten. di -3 dB)
'               o di risonanza (solo per JBT = 7 e JBT = 8).
'    FAt:       Per JBT < 5 e' la frequenza alla quale
'               l' attenuazione deve essere di almeno Att# dB.
'    Att:       Attenuazione desiderata in [dB] alla frequenza FAt#.
'    Rip:       Ondulazione in Banda Passante espressa come
'               percentuale del guadagno (solo per Chebyshev).
'    F1:        Prima frequenza di taglio dopo la trasformazione.
'    F2:        Seconda frequenza di taglio dopo la trasformazione.
'    Q:         Solo per JBT = 7 e JBT = 8, e' il Q del risonatore.
'    Alfa:      Alfa dato per filtro JBT = 9; per specificare, invece,
'               la FCt passare Alfa = -1.
'
'   Parametri in uscita
'    AttTot:    Attenuazione ottenuta in [dB] alla frequenza FAt#.
'    FCt:       Frequenza di taglio ottenuta per filtro JBT = 9 con Alfa dato.
'    Alfa:      Alfa ottenuto per filtro JBT = 9 con FCt dato.
'
'   I coefficienti del filtro vengono calcolati nelle
'   matrici Ac(0 To NK, 1 To NCel) e Bc(0 To NK, 1 To NCel)
'   con NK = ordine del filtro e NCel = numero di sezioni.
'   In questa versione viene anche dimensionata la matrice
'   W() dei registri delle sezioni del filtro.
'
DimN&,I&,K&,NC&,M$
DimOm#,Cm#,a#,A0#,A1#,A2#,B0#,B1#,B2#' Variabili per filtri elementari.
Dimf#,FF#,FCTA#,FATA#,Eps#,ATL#,res#' Variabili per
DimAB#,AT#,Bt#,TETAP#,P1#,P2#,P3#' filtri di tipo
DimCAPPA#,COSTA#,TOT#,CC#,AL#,Rn#' Butterworth e Chebyshev.
'
OnErrorGoToSintesiIIR_BT_ERR
'
'-- Filtri elementari ------------------------------------------------------------------
If(Trans$="RC Type Low Pass Filter")_
Or(Trans$="RC Type High Pass Filter")_
Or(Trans$="U(t) = a·I(t) + (1-a)·U(t-1)")Then
' Calcolo di tipi di filtro elementari del 1° ordine.
' Vedi Sub zNote:
Om=PI2*FCt' Pulsazione di taglio [rad/s].
'
SelectCaseTrans$
Case"RC Type Low Pass Filter"
Cm=Om/Tan(PI*FCt)' Costante di mappatura.
a=1#+Cm/Om
A0=1#/a
A1=1#/a
B0=1#
B1=(1#-Cm/Om)/a
'
Case"RC Type High Pass Filter"
Cm=Om/Tan(PI*FCt)' Costante di mappatura.
a=1#+Cm/Om
A0=(Cm/Om)/a
A1=-(Cm/Om)/a
B0=1#
B1=(1#-Cm/Om)/a
'
Case"U(t) = a·I(t) + (1-a)·U(t-1)"
' a := Alfa
If(Alfa<0#)Then
' E' data FCt; calcola Alfa per avere la FCt voluta:
Alfa=Cos(Om)-1#+Sqr(Cos(Om)^2-4#*Cos(Om)+3#)
ElseIf(Alfa<2#*(Sqr2-1#))Then
' E' data Alfa; calcola la FCt (se < 0.5) corrispondente:
Om=Acos(((Alfa^2)+2#*Alfa-2#)/(2#*Alfa-2#))
FCt=Om/PI2
EndIf
A0=Alfa
A1=0#
B0=1#
B1=-(1#-Alfa)
EndSelect
'
NCel=1
NK=1
ReDimAc(0ToNK,1ToNCel)' Coefficienti del filtro
ReDimBc(0ToNK,1ToNCel)' calcolati in Doppia Precisione.
ReDimw(0ToNK,1ToNCel)
Ac(0,1)=A0
Ac(1,1)=A1
Bc(0,1)=B0
Bc(1,1)=B1
AttTot=1#
'
GoToSintesiIIR_BT_End
'
ElseIf(Trans$="Resonator")_
Or(Trans$="Notch Filter")Then
' Calcolo di tipi di filtro elementari del 2° ordine.
' Vedi Sub zNote:
Om=PI2*FCt' Pulsazione di risonanza [rad/s].
Cm=Om/Tan(PI*FCt)' Costante di mappatura.
'
' Calcola i poli:
a=1#+Cm/(q*Om)+(Cm^2/Om^2)
B0=1#
B1=2#*(1#-Cm^2/Om^2)/a
B2=(1#-Cm/(q*Om)+(Cm^2/Om^2))/a
'
SelectCaseTrans$
Case"Resonator"
' Mette due zeri reali a ± 1:
A0=Cm/a
A1=0#
A2=-Cm/a
'
Case"Notch Filter"
' Mette una coppia di zeri complessi coniugati:
Rn=Sqr(B2)
' TETAP = Acos(-B1 / (2# * Rn))
A0=1#
A1=B1/Rn' -2 * Cos(TETAP)
A2=1#' Cos(TETAP) ^ 2 + Sin(TETAP) ^ 2
EndSelect
'
NCel=1
NK=2
ReDimAc(0ToNK,1ToNCel)' Coefficienti del filtro
ReDimBc(0ToNK,1ToNCel)' calcolati in Doppia Precisione.
ReDimw(0ToNK,1ToNCel)
Ac(0,1)=A0
Ac(1,1)=A1
Ac(2,1)=A2
Bc(0,1)=B0
Bc(1,1)=B1
Bc(2,1)=B2
AttTot=1#
'
GoToSintesiIIR_BT_End
EndIf
'
'-- Filtri Butterworth e Chebyshev -----------------------------------------------------
FCTA=Tan(PI*FCt)
FATA=Tan(PI*FAt)
FF=FATA/FCTA
If(Proty$="Chebyshev")ThenEps=Sqr(1#/(1#-Rip/100#)^2#-1#)
ATL=10#^(Att/10#)
'
'       COMPUTATION OF THE ORDER OF THE FILTER.
'       ---------------------------------------
'
N=0
Do
N=N+1
SelectCaseProty$
Case"Butterworth"
res#=1#/(1#+FF^(2*N))
'
Case"Chebyshev"
CEB(1)=1#
CEB(2)=FF
If(1<N)Then
f=FF+FF
ForI=2ToN
CEB(I+1)=f*CEB(I)-CEB#(I-1)
NextI
EndIf
res=1#/(1#+(Eps*CEB(N+1))^2)
EndSelect
LoopWhileres>=ATL
'
If((NMod2)=1)Then
N=N+1
SelectCaseProty$
Case"Butterworth"
res=1#/(1#+FF^(2*N))
'
Case"Chebyshev"
CEB(1)=1
CEB(2)=FF
f=FF+FF
ForI=2ToN
CEB(I+1)=f*CEB(I)-CEB(I-1)
NextI
res=1#/(1#+(Eps*CEB(N+1))^2)
EndSelect
EndIf
'
If(2*NCMax<N)Then
M$="**** ERRORE ****"&vbNewLine
M$=M$&vbNewLine&"Per ottenere il filtro richiesto"&vbNewLine
M$=M$&"si devono usare "&Str$(N/2)&" Sezioni."&vbNewLine
M$=M$&"Il numero Massimo e'"&Str$(NCMax)&"."&vbNewLine
M$=M$&vbNewLine&"Provare a variare i dati del filtro."
MsgBoxM$,vbCritical," modDSP: Sintesi IIR"
SintesiIIR_BT=False
DoEvents
ExitFunction
EndIf
'
AttTot=10#*Log(res)/Log10
NCel=N/2
NK=Switch(Trans$="No Transformation",2,_
Trans$="Low Pass -> Low Pass",2,_
Trans$="Low Pass -> High Pass",2,_
Trans$="Low Pass -> Band Pass",4,_
Trans$="Low Pass -> Band Stop",4)
ReDimAc(0ToNK,1ToNCel)' Coefficienti del filtro.
ReDimBc(0ToNK,1ToNCel)' Calcolati in Doppia Precisione.
ReDimPOLRE(1ToNCel)' Vettori in uso durante la Sintesi.
ReDimPOLIM(1ToNCel)'""""
ReDimw(0ToNK,1ToNCel)
'
'       POLE POSITION EVALUATION.
'       -------------------------
'
AT=FCTA
Bt=FCTA
If(Proty$="Chebyshev")Then
AB=((1#+Sqr(1#+Eps^2))/Eps)^(1#/N)
AT=(AB-1#/AB)*AT/2#
Bt=(AB+1#/AB)*Bt/2#
EndIf
ForNC=1ToNCel
TETAP=PI#*(2#*NC-1#)/(2#*N)
POLRE(NC)=-AT*Cos(TETAP)
POLIM(NC)=Bt*Sin(TETAP)
NextNC
ForNC=1ToNCel
P1=POLIM(NC)^2
P2=(1#-POLRE(NC))^2
P3=POLRE(NC)^2
POLRE(NC)=(1#-P3-P1)/(P2+P1)
POLIM(NC)=(2#*POLIM(NC))/(P2+P1)
NextNC
'
'       EVALUATION OF THE SECOND ORDER SECTION COEFFICIENTS.
'       ----------------------------------------------------
'
ForNC=1ToNCel
Bc(0,NC)=1#
Bc(1,NC)=-2#*POLRE(NC)
Bc(2,NC)=POLRE(NC)*POLRE(NC)+POLIM(NC)*POLIM(NC)
NextNC
'
SelectCaseProty$
Case"Butterworth"
COSTA=1#
'
Case"Chebyshev"
COSTA=(1#-Rip/100#)^(1#/NCel)
EndSelect
'
ForNC=1ToNCel
TOT=4#/(Bc(0,NC)+Bc(1,NC)+Bc(2,NC))
CC=TOT/COSTA
Ac(0,NC)=1#/CC
Ac(1,NC)=2#/CC
Ac(2,NC)=1#/CC
NextNC
'
'       FREQUENCY TRANSFORMATION.
'       -------------------------
'
SelectCaseTrans$
Case"No Transformation"
GoToSintesiIIR_BT_End
'
Case"Low Pass -> Low Pass"
AL=Sin(PI*(FCt-F1))/Sin(PI*(FCt+F1))
A0=-AL
A1=1#
A2=0#
B0=A1
B1=A0
B2=0#
'
Case"Low Pass -> High Pass"
AL=-Cos(PI*(FCt+F1))/Cos(PI*(FCt-F1))
A0=-AL
A1=-1#
A2=0#
B0=-A1
B1=-A0
B2=0#
'
Case"Low Pass -> Band Pass"
AL=Cos(PI*(F2+F1))/Cos(PI*(F2-F1))
CAPPA=Tan(PI*FCt)/Tan(PI*(F2-F1))
A0=-(CAPPA-1#)/(CAPPA+1#)
A1=2#*AL*CAPPA#/(CAPPA+1#)
A2=-1#
B0=-A2
B1=-A1
B2=-A0
'
Case"Low Pass -> Band Stop"
AL=Cos(PI*(F2+F1))/Cos(PI*(F2-F1))
CAPPA=Tan(PI*FCt)*Tan(PI*(F2-F1))
A0=(1#-CAPPA)/(1#+CAPPA)
A1=-2#*AL/(1#+CAPPA)
A2=1#
B0=A2
B1=A1
B2=A0
EndSelect
'
AN(0,0)=B0*B0
AN(1,0)=2#*B0*B1
AN(2,0)=B1*B1+2#*B0*B2
AN(3,0)=2#*B1*B2
AN(4,0)=B2*B2
AN(0,1)=A0*B0
AN(1,1)=A0*B1+A1*B0
AN(2,1)=A0*B2+A1*B1+A2*B0
AN(3,1)=A1*B2+A2*B1
AN(4,1)=A2*B2
AN(0,2)=A0*A0
AN(1,2)=2#*A0*A1
AN(2,2)=A1*A1+2#*A0*A2
AN(3,2)=2#*A1*A2
AN(4,2)=A2*A2
'
ForNC=1ToNCel
ForK=0To2
FINA(K)=Ac(K,NC)
FINB(K)=Bc(K,NC)
NextK
ForK=0ToNK
Ac(K,NC)=0#
Bc(K,NC)=0#
ForI=0To2
Ac(K,NC)=AN(K,I)*FINA(I)+Ac(K,NC)
Bc(K,NC)=AN(K,I)*FINB(I)+Bc(K,NC)
NextI
NextK
NextNC
ForNC=1ToNCel
Rn=Bc(0,NC)
ForK=0ToNK
Ac(K,NC)=Ac(K,NC)/Rn
Bc(K,NC)=Bc(K,NC)/Rn
NextK
NextNC
'
'
SintesiIIR_BT_End:
SintesiIIR_BT_ERR:
SintesiIIR_BT=(Err.Number=0)
If(Err.Number<>0)Then
M$=FiltroErrIIR$&vbNewLine&vbNewLine
M$=M$&"Errore "&Str$(Err.Number)&vbNewLine
M$=M$&Err.Description
MsgBoxM$,vbCritical," modDSP: SintesiIIR_BT"
EndIf
'
'
'
EndFunction
PrivateSubzNote()
'
'   Metodi di calcolo dei filtri elementari.
'   - Algoritmi di trasformazione da "Digital Signal Processing"
'     di W. D. Stanley - pg. 172, 173, 174.
'   - La funzione di trasferimento del risuonatore reale parallelo
'     e' tratta da "Teoria delle Reti Elettriche", Appunti dai
'     corsi del Politecnico di Torino - pg. (1.3)1 e seg.
'   - L' idea della sostituzione degli zeri per il "Notch Filter"
'     proviene da: http://www-users.cs.york.ac.uk/~fisher/mkfilter/res.html
'
'---------------------------------------------------------------------------------------
'"RC Type Low Pass Filter":
'   La funzione di trasferimento e':
'
'   U(p)       1                    con:
'   ---- = -----------               Fc = 1/(2*PI*RC)   frequenza di taglio a -3 dB [Hz].
'   I(p)   1 + RC*p                  C, R               capacita' e resistenza
'                                                       del circuito.
'
'   Le formule di trasformazione (1) da:
'
'           A0 + A1*p                 1
'    G(p) = ---------   -->  -------------------
'           B0 + B1*p        1 + (1/(2*PI*Fc))*p
'   a:
'                    -1
'           a0 + a1*z
'    H(z) = -----------
'                    -1
'           1  + b1*z
'
'   sono:                           con:
'    Cm = 2*PI*FCt/Tan(2*PI*FCt/2)   FCt = Fc/Fs  -->  0 <= FCt <= 0.5
'    A  =  B0 + B1*Cm                A0 = 1
'    a0 = (A0 + A1*Cm)/A             A1 = 0
'    a1 = (A0 - A1*Cm)/A             B0 = 1
'    b1 = (B0 - B1*Cm)/A             B1 = 1/(2*PI*FCt)
'
'
'---------------------------------------------------------------------------------------
'"RC Type High Pass Filter":
'   La funzione di trasferimento e':
'
'   U(p)      RCp                   con:
'   ---- = -----------               Fc = 1/(2*PI*RC)   frequenza di taglio a -3 dB [Hz].
'   I(p)   1 + RC*p                  C, R               capacita' e resistenza
'                                                       del circuito.
'
'   si usano le formule di trasformazione (1) con:
'                                              FCt = Fc/Fs  -->  0 <= FCt <= 0.5
'                                              A0 = 0
'                                              A1 = 1/(2*PI*FCt)
'                                              B0 = 1
'                                              B1 = 1/(2*PI*FCt)
'
'
'---------------------------------------------------------------------------------------
'"Resonator":
'   La funzione di trasferimento e':
'
'    U(p)                  P                    con:
'    ---- = ---------------------------------    Oc = 1/Sqr(L*C)    pulsazione di risonanza [rad/s].
'    I(P)   1 + (1/(Q*Oc))*P + (1/(Oc^2))*P^2    Fc = Oc/(2*PI)     frequenza di risonanza [Hz].
'                                                L, C, Rp           induttanza, capacita' e
'                                                                   resistenza in parallelo
'                                                                   del circuito risonante.
'                                                Q = Oc*Rp*C        coefficiente di risonanza.
'
'   Le formule di trasformazione (2) da:
'
'           A0 + A1*p + A2*p^2                         p
'    G(p) = ------------------   -->  ---------------------------------
'           B0 + B1*p + B2*p^2        1 + (1/(Q*Oc))*P + (1/(Oc^2))*P^2
'   a:
'                    -1     -2
'           a0 + a1*z + a2*z
'    H(z) = ------------------
'                    -1     -2
'           1  + b1*z + b2*z
'
'   sono:                             con:
'    Cm = 2*PI*FCt/Tan(2*PI*FCt/2)     FCt = Fc/Fs  -->  0 <= FCt <= 0.5
'    A  =  B0 + B1*Cm + B2*Cm^2        A0 = 0
'    a0 = (A0 + A1*Cm + A2*Cm^2)/A     A1 = 1
'    a1 = (2*A0 - 2*A2*Cm^2)/A         A2 = 0
'    a2 = (A0 - A1*Cm + A2*Cm^2)/A     B0 = 1
'    b1 = (2*B0 - 2*B2*Cm^2)/A         B1 = 1/(2*PI*FCt*Q)
'    b2 = (B0 - B1*Cm + B2*Cm^2)/A     B2 = 1/(2*PI*FCt)^2
'
'---------------------------------------------------------------------------------------
'"Notch Filter":
'   L' algoritmo precedente costruisce una funzione di trasferimento H(z) avente
'   una coppia di zeri reali a ± 1; questo consente di avere guadagno zero alle
'   basse ed alle alte frequenze.
'   Il "Notch Filter" viene ricavato dal "Resonator" sostituendo questa coppia di
'   zeri reali con due zeri complessi coniugati, giacenti sul cerchio unitario e
'   con argomento uguale a quello dei poli (anch' essi complessi coniugati).
'
'   Se Zp = r*Exp(± i*Theta) sono i poli di H(z), gli zeri devono essere:
'
'    Zz = Exp(± i*Theta)
'
'   Viene usata la relazione:
'
'                          -1                        -1
'    (1 - r*Exp(+i*Theta)*z  )*(1 - r*Exp(-i*Theta)*z  ) =
'
'                          -1   2   -2           -1      -2
'    = 1 - 2*r*Cos(Theta)*z  + r * z   = 1 + b1*z  + b2*z       (i = Sqr(-1))
'
'   da cui:
'
'    r = Sqr(b2)
'    Theta = Acos(-b1/(2*Sqr(b2))
'
'   e quindi:
'
'             -1     -2                       -1  -2
'    a0 + a1*z + a2*z  = 1 + (b1/(2*Sqr(b2))*z + z
'
'---------------------------------------------------------------------------------------
'"U(t) = a·I(t) + (1-a)·U(t-1)"
'   La funzione di trasferimento e':
'
'                a
'    H(z) = ----------------
'                         -1
'           1  - (1 - a)*z
'
'   Usando, invertite, le formule di trasformazione (1) si ha:
'
'              a*Cm - a*p
'    G(p) = ---------------             con: Cm = Oc/Tan(Oc/2)
'           a*Cm + (2 - a)*p                 Oc = 2*PI*Fc
'
'   La pulsazione di taglio Oc si ha per:
'
'          |a*Cm - a*i*Oc|       1
'    ----------------------- = ------   con: p = i*Oc
'      |a*Cm + (2 - a)*i*Oc|   Sqr(2)        i = Sqr(-1)
'
'   da cui si ricava il valore di a necessario per
'   ottenere la frequenza di taglio FCt voluta:
'
'    a = Cos(Oc) - 1 + Sqr(Cos(Oc)^2 - 4*Cos(Oc) + 3)   sempre con: Oc  = 2*PI*FCt
'                                                                   FCt = Fc/Fs
'
'   Se invece viene dato a, si ottiene una FCt corrispondente:
'
'    FCt = Acos(((a^2) + 2*a - 2)/(2*a - 2))/(2*PI)     solo per:   a   < 2*(Sqr(2) - 1)
'                                                       e:          FCt < 0.5
'
'
'
EndSub
SubDFT(ByValNVAL&,d()AsDouble,r()AsDouble,X()AsDouble,_
s()AsDouble,f()AsDouble,ByValNFRE&)
'
'   Definizioni:
'
'   DFT = Discrete Fourier Transform.
'
'   Entra con:
'       NVAL   = Numero max. dei dati in D() da usare.
'       D()    = Vettore dei dati Reali del Segnale(t).
'       NFRE   = Numero  dei valori di Frequenza calcolati.
'
'   Esce  con:
'       R()    = Vettore dei valori Reali      della Trasformata(f).
'       X()    = Vettore dei valori Immaginari della Trasformata(f).
'       S()    = Vettore dello Spettro di Amp. della Trasformata(f).
'       F()    = Vettore delle Fasi            della Trasformata(f) [rad].
'
'   I valori della trasformata in R(), X() NON vengono
'   normalizzati sulla lunghezza del Segnale NVAL.
'
'   Gli NVAL dati nel vettore D() sono organizzati come D(0 To NVAL - 1).
'   Gli NFRE dati nei vettori R(), X(), S() e F() sono organizzati come Vettore(0 To NFRE).
'
'   Viene calcolata in R(0 To NFRE), X(0 To NFRE) solo la prima
'   meta' dello spettro per i valori di frequenza  NFRE = NVAL/2
'   piu' la Componente Continua in R(0).
'
'   Algoritmi tratti da: "Digital Time Series Analysis" di R. Otnes
'   e L. Enochson - pg. 138.  Nessun tentativo e' stato fatto per
'   migliorare la velocita' di esecuzione (tipo look-up table e/o
'   valutazione ricorsiva delle funzioni trigonometriche).
'
DimJF&,JD&,PI2_V#,Omega#,OmT#,NFRE_D#
'
'NFRE = Int(NVAL / 2)
NFRE_D=CDbl(NVAL)/2#
PI2_V=PI2/CDbl(NVAL)
'
ForJF=0ToNFRE
Omega=PI2_V*CDbl(JF)
r(JF)=0#
X(JF)=0#
'
ForJD=0ToNVAL-1
OmT=Omega*CDbl(JD)
r(JF)=r(JF)+d(JD)*Cos(OmT)
X(JF)=X(JF)+d(JD)*Sin(OmT)
NextJD
NextJF
'
' Calcolo dello Spettro di Ampiezza e delle Fasi:
s(0)=Abs(r(0))/CDbl(NVAL)
f(0)=IIf(r(0)<0#,PI,0#)
ForJF=1ToNFRE-1
s(JF)=Sqr(r(JF)*r(JF)+X(JF)*X(JF))/NFRE_D
f(JF)=DATAN2(-X(JF),r(JF))' Scala da -PI a  +PI.
'F(JF) = Atan2(-X(JF), R(JF))    ' Scala da 0 a  +2PI.
NextJF
If(NVALMod2)=0Then
s(NFRE)=Abs(r(NFRE))/CDbl(NVAL)
f(NFRE)=IIf(r(NFRE)<0#,PI,0#)
Else
s(NFRE)=Sqr(r(NFRE)*r(NFRE)+X(NFRE)*X(NFRE))/NFRE_D
f(NFRE)=DATAN2(-X(NFRE),r(NFRE))' Scala da -PI a  +PI.
'F(NFre) = Atan2(-X(NFre), R(NFre))  ' Scala da 0 a  +2PI.
EndIf
'
'
'
EndSub
PublicSubFFT(d()AsDouble,r()AsDouble,X()AsDouble,_
s()AsDouble,f()AsDouble,ByRefNVALAsLong,ByRefNFREAsLong)
'
'   Definizioni:
'
'   FFT = Fast Fourier Transform.
'
'   Entra con:
'       D()   = Vettore dei dati Reali del Segnale(t).
'       NVAL  = Numero max. dei dati in D() da usare.
'
'   Esce  con:
'       R()   = Vettore dei valori Reali      della Trasformata(f).
'       X()   = Vettore dei valori Immaginari della Trasformata(f).
'       S()   = Vettore dello Spettro di Amp. della Trasformata(f).
'       F()   = Vettore delle Fasi            della Trasformata(f) [Radianti].
'       NVAL  = Numero  dei dati usati        dalla Trasformata(f).
'       NFRE  = Numero  dei valori di Frequenza calcolati.
'
'   I valori della Trasformata in R(), X() NON vengono
'   normalizzati sulla lunghezza del Segnale 2^M.
'
'   I vettori R(), X(), S() e F() sono dimensionati in questa routine.
'   Gli NN dati nei vettori sono organizzati come Vettore(0 To NN - 1).
'
'   Tradotta in Basic da: "Theory and Application of Digital
'   Signal Processing" di L. Rabiner e B. Gold. - pg. 367.
'
'   Ver. 18/10/2005 modificata per AudioCardDSP.
'
DimM&,I&,NMN1&,J&,K&,L&,LE&,LE1&,IP&,JF&
DimTSwap#,Ur#,Ui#,wr#,wi#,Tr#,Ti#
'
M=Int(Log(CDbl(NVAL)+0.5)/Log2)
NVAL=2^M
NFRE=NVAL/2
NMN1=NVAL-1
'
ReDimr(0ToNVAL-1),X(0ToNVAL-1)
ReDims(0ToNFRE),f(0ToNFRE)
'
' Solo per segnali di ingresso reali e se non si vogliono
' sfruttare le proprieta'"transform-in-place" di questa
' implementazione:
ForI=0ToNVAL-1
r(I)=d(I)
X(I)=0#' Per segnali di ingresso complessi
' mettere la componente immaginaria.
NextI
'
J=0
ForI=0ToNMN1-1
If(I<J)Then
' dSwap R(J), R(I):
TSwap=r(J)
r(J)=r(I)
r(I)=TSwap
'dSwap X(J), X(I) ' Solo per segnali complessi.
EndIf
K=NFRE
DoWhile(K-1<J)
J=J-K
K=K/2
Loop
J=J+K
NextI
'
ForL=1ToM
LE=2^L
LE1=LE/2
Ur=1#
Ui=0#
wr=Cos(PI/LE1)
wi=Sin(PI/LE1)
ForJ=0ToLE1-1
ForI=JToNVAL-1StepLE
IP=I+LE1
Tr=r(IP)*Ur-X(IP)*Ui
Ti=r(IP)*Ui+X(IP)*Ur
r(IP)=r(I)-Tr
X(IP)=X(I)-Ti
r(I)=r(I)+Tr
X(I)=X(I)+Ti
NextI
Tr=Ur
Ti=Ui
Ur=Tr*wr-Ti*wi
Ui=Tr*wi+Ti*wr
NextJ
NextL
'
' Calcolo dello Spettro di Ampiezza e delle Fasi:
s(0)=Abs(r(0))/NVAL
f(0)=IIf(r(0)<0#,PI,0#)
ForJF=1ToNFRE-1
s(JF)=Sqr(r(JF)*r(JF)+X(JF)*X(JF))/NFRE
f(JF)=DATAN2(-X(JF),r(JF))' Scala da -PI a  +PI.
'F(JF) = Atan2(-X(JF), R(JF))    ' Scala da 0 a  +2PI.
NextJF
s(NFRE)=Abs(r(NFRE))/NVAL
f(NFRE)=IIf(r(NFRE)<0#,PI,0#)
'
'
'
EndSub
PublicFunctionWinProf(ByValWNome$,ByValNWind&,OptionalByValParAsDouble)AsDouble()
'
'   Calcola e ritorna un vettore con i coefficienti della Window richiesta.
'    WNome$:    nome della Window richiesta.
'    NWind:     N° di coefficienti richiesto.
'    Par:       parametro richiesto per certi tipi di Window.
'
DimK&,KK&,NOdd&,NWind1&
DimBB#,AA#,Ak#,Arg#,ArgL#,ArgW#,NWind_1#
ReDimWF_I#(0ToNWind-1)
'
NOdd=NWindMod2
NWind1=Int(NWind/2)
If(NOdd=1)ThenWF_I(NWind1)=1#
NWind_1=CDbl(NWind-1)
'
AA=0.5*(1#-CDbl(NOdd))
BB=CDbl(NWind1)-AA
'
' Calcolo la prima meta' del vettore:
SelectCaseWNome$
Case"Bartlett"
' Zero valued end-points:
ForK=0ToNWind1-1
WF_I(K)=(2#/NWind_1)*((NWind_1/2#)-Abs(K-(NWind_1/2#)))
NextK
'
Case"Bartlett-Hann"
ForK=0ToNWind1-1
WF_I(K)=0.62-0.48*(Abs((K/NWind_1)-0.5))_
-0.38*Cos(PI2*CDbl(K)/NWind_1)
NextK
'
Case"Blackman"
ForK=0ToNWind1-1
WF_I(K)=0.42_
-0.5*Cos(PI2*CDbl(K)/NWind_1)_
+0.08*Cos(2#*PI2*CDbl(K)/NWind_1)
NextK
'
Case"Blackman-Harris"
ForK=0ToNWind1-1
WF_I(K)=0.35875_
-0.48829*Cos(1#*PI2*CDbl(K)/NWind_1)_
+0.14128*Cos(2#*PI2*CDbl(K)/NWind_1)_
-0.01168*Cos(3#*PI2*CDbl(K)/NWind_1)
NextK
'
Case"Blackman-Nuttal"
ForK=0ToNWind1-1
WF_I(K)=0.3635819_
-0.4891775*Cos(1#*PI2*CDbl(K)/NWind_1)_
+0.1365995*Cos(2#*PI2*CDbl(K)/NWind_1)_
-0.0106411*Cos(3#*PI2*CDbl(K)/NWind_1)
NextK
'
Case"Flat top"
ForK=0ToNWind1-1
WF_I(K)=0.21557895_
-0.41663158*Cos(1#*PI2*CDbl(K)/NWind_1)_
+0.2772631*Cos(2#*PI2*CDbl(K)/NWind_1)_
-0.083578947*Cos(3#*PI2*CDbl(K)/NWind_1)_
+0.006947368*Cos(4#*PI2*CDbl(K)/NWind_1)
NextK
'
Case"Gauss"
ForK=0ToNWind1-1
WF_I(K)=Exp(-0.5*((K-NWind_1/2)/(Par*NWind_1/2))^2)
NextK
'
Case"Hamming generalizzata"
ForK=0ToNWind1-1
WF_I(K)=Par-(1#-Par)*Cos(PI2*CDbl(K)/NWind_1)
NextK
'
Case"Hamming"
' E' l'"Hamming generalizzata" con Par = 0.54:
ForK=0ToNWind1-1
WF_I(K)=0.54-0.46*Cos(PI2*CDbl(K)/NWind_1)
NextK
'
Case"Hanning"
' E' l'"Hamming generalizzata" con Par = 0.5:
ForK=0ToNWind1-1
WF_I(K)=0.5-0.5*Cos(PI2*CDbl(K)/NWind_1)
NextK
'
Case"Kaiser"
ForK=0ToNWind1-1
Ak=Par*Sqr(1#-((2#*CDbl(K)/NWind_1)-1#)^2)
WF_I(K)=I0_Kaiser(Ak)/I0_Kaiser(Par)
NextK
'
Case"Lanczos"
ArgL=PI/BB
ForK=0ToNWind1-1
Ak=CDbl(NWind1-K)-AA
Arg=ArgL*Ak
WF_I(K)=Abs(Sin(Arg)/Arg)^Par
NextK
'
Case"Nuttal"
ForK=0ToNWind1-1
WF_I(K)=0.355768_
-0.487396*Cos(1#*PI2*CDbl(K)/NWind_1)_
+0.144232*Cos(2#*PI2*CDbl(K)/NWind_1)_
-0.012604*Cos(3#*PI2*CDbl(K)/NWind_1)
NextK
'
Case"Rettangolare"
ForK=0ToNWind1-1
WF_I(K)=1#
NextK
'
Case"Triangolare"
ForK=0ToNWind1-1
'WF_I(K) = CDbl(K) / CDbl(NWind1)
'
' Non-zero end-points:
WF_I(K)=(2#/NWind)*((NWind/2#)-Abs(K-(NWind_1/2#)))
NextK
'
Case"Weber"
ArgW=1.5*Par/BB
ForK=0ToNWind1-1
Ak=CDbl(NWind1-K)-AA
Arg=ArgW*Ak
If(Arg<=0.75)Then
WF_I(K)=A0+A1*Arg+A2*Arg^2+A3*Arg^3
Else
WF_I(K)=B0+B1*Arg+B2*Arg^2+B3*Arg^3
EndIf
NextK
'
Case"Welch"
ForK=0ToNWind1-1
WF_I(K)=1#-((K-NWind_1/2#)/(NWind_1/2#))^2
NextK
EndSelect
'
'
' Completo il vettore
' con la seconda meta':
ForK=0ToNWind1-1
KK=NWind-1-K
WF_I(KK)=WF_I(K)
NextK
'
WinProf=WF_I()
'
'
'
EndFunction
PrivateFunctionI0_Kaiser(ByValXAsDouble,OptionalByRefNAsLong)AsDouble
'
'   Calcola e ritorna la funzione di Bessel modificata del primo
'   tipo e di ordine zero per 0 <= X <= 20.  N e' il numero
'   di iterazioni impiegate per la convergenza.
'    Da: Theory and Application of Digital Signal Processing.
'        L. R. Rabiner, B. Gold   -   pg. 103
'
DimY#,e#,de#,SDE#
Constt#=0.00000001
'
Y=X/2#
e=1#
de=1#
ForN=1To25
de=de*Y/CDbl(N)
SDE=de^2
e=e+SDE
If(0#<(e*t-SDE))Then
I0_Kaiser=e
ExitFunction
EndIf
NextN
'
N=0
'
'
'
EndFunction
PublicFunctionWinTipi()AsWindow_Type()
'
'   Imposta i parametri dei tipi di
'"Window" disponibili:
'    Profilo da File:       WinTipi(0)  -> non usato, in questa applicazione.
'    Bartlett:              WinTipi(1)
'    Bartlett-Hann:         WinTipi(2)
'    Blackman:              WinTipi(3)
'    Blackman-Harris:       WinTipi(4)
'    Blackman-Nuttal:       WinTipi(5)
'    Flat top:              WinTipi(6)
'    Gauss:                 WinTipi(7)
'    Hamming generalizzata: WinTipi(8)
'    Hamming:               WinTipi(9)
'    Hanning:               WinTipi(10)
'    Kaiser:                WinTipi(11)
'    Lanczos:               WinTipi(12)
'    Nuttal:                WinTipi(13)
'    Rettangolare:          WinTipi(14)
'    Triangolare:           WinTipi(15)
'    Weber:                 WinTipi(16)
'    Welch:                 WinTipi(17)
'
DimI&,WTipi()AsWindow_Type
'
I=0
ReDimWTipi(0ToI)
WTipi(I).Nome="--> Nome del File"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Bartlett"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Bartlett-Hann"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Blackman"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Blackman-Harris"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Blackman-Nuttal"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Flat top"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Gauss"
WTipi(I).PMin=0.05
WTipi(I).PMax=0.5
WTipi(I).PCor=0.2
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Hamming generalizzata"
WTipi(I).PMin=0.5
WTipi(I).PMax=1#
WTipi(I).PCor=0.5
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Hamming"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Hanning"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Kaiser"
WTipi(I).PMin=0.5
WTipi(I).PMax=20#
WTipi(I).PCor=10#
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Lanczos"
WTipi(I).PMin=0.5
WTipi(I).PMax=3.5
WTipi(I).PCor=1.4
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Nuttal"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Rettangolare"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Triangolare"
WTipi(I).PMin=-1
WTipi(I).PMax=-1
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Weber"
WTipi(I).PMin=0.5
WTipi(I).PMax=1#
WTipi(I).PCor=1#
'
I=I+1
ReDimPreserveWTipi(0ToI)
WTipi(I).Nome="Welch"
WTipi(I).PMin=0.5
WTipi(I).PMax=-1
WTipi(I).PCor=-1
'
WinTipi=WTipi()
'
'
'
EndFunction
PublicSubSFFTBF(ByValNAsLong,d()AsDouble,_
ByRefRe()AsDouble,ByRefIm()AsDouble,ByValNFREAsLong)
'
'   SFFTBF(D, N, MM, S1, C1, S3, C3, ITAB)
'
'   A real-valued, in place, split-radix FFT program
'   Real input and output in data array D
'   Length is N = 2 ** MM
'   Decimation-in-time, cos/sin in second loop with table look-up
'   Output in order:
'    [ Re(0), Re(1), ..., Re(N/2), Im(N/2-1), ..., Im(1) ]
'
'    S1 - array of sin() table (length >= N/8-1)
'    C1 - array of cos() table (length >= N/8-1)
'    S3 - array of sin() table (length >= N/8-1)
'    C3 - array of cos() table (length >= N/8-1)
'    ITAB - integer bit reversal table (length >= sqrt(2n) )
'
'   The initialization routine SFFTBI must be called prior to calling
'   this routine.  SFFTBI need not be called again unless N changes.
'
'   Original code (RVFFT) written by H.V. Sorensen,
'                                    Rice University, Oct. 1985
'
'   Modifications made by Steve Kifowit, 26 June 1997
'    -- table look-up of sines and cosines
'    -- incorporation of bit reversal table
'    -- quick return
'
'   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
'
'   Entra con:
'       N     = Numero max. di dati in D() da usare.
'       D()   = Vettore dei valori Reali del Segnale(t).
'       NFRE  = Numero dei valori di Frequenza da calcolare.
'
'   Esce  con:
'       Re()  = Vettore dei valori Reali      della Trasformata(f).
'       Im()  = Vettore dei valori Immaginari della Trasformata(f).
'
'   I valori della trasformata in Re(), Im() NON vengono
'   normalizzati sulla lunghezza del Segnale 2^MM.
'
'   Gli N dati nel vettore D() sono organizzati come D(0 To N - 1);
'   gli NFre_C + 1 dati nei vettori Re() e Im() sono organizzati come
'   Vettore(0 To NFre).
'
'   Ver: 27/10/2006.
'
DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
DimN1&,N2&,N4&,N8&,NN&,It&
DimXT#,R1#,t1#,T2#,T3#,T4#,T5#,T6#
DimCC1#,SS1#,CC3#,SS3#,NFreq#
'
If(N=1)ThenExitSub
'
' Sposto i dati di ingresso nel vettore D1() per non distruggerli
' e per avere un vettore a base 1 come richiesto da questa routine:
CopyMemoryD1(1),d(0),8*N
'
N1=ITAB(1)
ForK=2ToN1
I0=N1*ITAB(K)+1
I=K
J=I0
ForIt=2ToITAB(K)+1
XT=D1(I)
D1(I)=D1(J)
D1(J)=XT
I=I+N1
J=I0+ITAB(It)
NextIt
NextK
'
Ic=1
ID=4
70
ForI0=IcToNStepID
I1=I0+1
R1=D1(I0)
D1(I0)=R1+D1(I1)
D1(I1)=R1-D1(I1)
NextI0
Ic=2*ID-1
ID=4*ID
If(Ic<N)ThenGoTo70
'
N2=2
NN=N/2
ForK=2ToMM
N2=N2*2
N4=N2/4
N8=N2/8
NN=NN/2
Ic=0
ID=N2*2
40
ForI=IcToN-1StepID
I1=I+1
I2=I1+N4
I3=I2+N4
I4=I3+N4
t1=D1(I4)+D1(I3)
D1(I4)=D1(I4)-D1(I3)
D1(I3)=D1(I1)-t1
D1(I1)=D1(I1)+t1
If(N4=1)ThenGoTo38
I1=I1+N8
I2=I2+N8
I3=I3+N8
I4=I4+N8
t1=(D1(I3)+D1(I4))/Sqr2
T2=(D1(I3)-D1(I4))/Sqr2
D1(I4)=D1(I2)-t1
D1(I3)=-D1(I2)-t1
D1(I2)=D1(I1)-T2
D1(I1)=D1(I1)+T2
38'CONTINUE
NextI
Ic=2*ID-N2
ID=4*ID
If(Ic<N)ThenGoTo40
ForJ=2ToN8
It=(J-1)*NN
CC1=C1(It)
SS1=S1(It)
CC3=C3(It)
SS3=S3(It)
Ic=0
ID=2*N2
36
ForI=IcToN-1StepID
I1=I+J
I2=I1+N4
I3=I2+N4
I4=I3+N4
I5=I+N4-J+2
I6=I5+N4
I7=I6+N4
I8=I7+N4
t1=D1(I3)*CC1+D1(I7)*SS1
T2=D1(I7)*CC1-D1(I3)*SS1
T3=D1(I4)*CC3+D1(I8)*SS3
T4=D1(I8)*CC3-D1(I4)*SS3
T5=t1+T3
T6=T2+T4
T3=t1-T3
T4=T2-T4
T2=D1(I6)+T6
D1(I3)=T6-D1(I6)
D1(I8)=T2
T2=D1(I2)-T3
D1(I7)=-D1(I2)-T3
D1(I4)=T2
t1=D1(I1)+T5
D1(I6)=D1(I1)-T5
D1(I1)=t1
t1=D1(I5)+T4
D1(I5)=D1(I5)-T4
D1(I2)=t1
NextI
Ic=2*ID-N2
ID=4*ID
If(Ic<N)ThenGoTo36
NextJ
NextK
'
' Sistemo i valori calcolati in D1()
' nei vettori Re(), Im():
'For I = 0 To NFre
'    Re(I) = D1(I + 1)
'Next I
CopyMemoryRe(0),D1(1),8*(NFRE+1)
'
ForI=1ToNFRE-1
Im(I)=D1(N-I+1)
NextI
'
'   ... End of subroutine SFFTBF ...
'
EndSub
PublicSubSFFTBF_Corr(d()AsDouble,ByRefRe_C()AsDouble,ByRefIm_C()AsDouble)
'
'   SFFTBF(D, N_C, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C)
'
'   A real-valued, in place, split-radix FFT program
'   Real input and output in data array D
'   Length is N_C = 2 ** MM_C
'   Decimation-in-time, cos/sin in second loop with table look-up
'   Output in order:
'    [ Re_C(0), Re_C(1), ..., Re_C(N_C/2), Im_C(N_C/2-1), ..., Im_C(1) ]
'
'    S1_C   - array of sin() table (length >= N_C/8-1)
'    C1_C   - array of cos() table (length >= N_C/8-1)
'    S3_C   - array of sin() table (length >= N_C/8-1)
'    C3_C   - array of cos() table (length >= N_C/8-1)
'    ITAB_C - integer bit reversal table (length >= sqrt(2n) )
'
'   The initialization routine SFFTBI_Corr must be called prior to calling
'   this routine.  SFFTBI_Corr need not be called again unless N1_C or
'   N2_C change.
'
'   Original code (RVFFT) written by H.V. Sorensen,
'                                    Rice University, Oct. 1985
'
'   Modifications made by Steve Kifowit, 26 June 1997
'    -- table look-up of sines and cosines
'    -- incorporation of bit reversal table
'    -- quick return
'
'   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
'
'   Entra con:
'       N_C     = Numero max. di dati in D() da usare.
'       D()     = Vettore dei valori Reali del Segnale(t).
'       NFre_C  = Numero dei valori di Frequenza da calcolare.
'
'   Esce  con:
'       Re_C()  = Vettore dei valori Reali      della Trasformata(f).
'       Im_C()  = Vettore dei valori Immaginari della Trasformata(f).
'
'   I valori della trasformata in Re_C(), Im_C() NON vengono
'   normalizzati sulla lunghezza del Segnale 2^MM_C.
'
'   Gli N_C dati nel vettore D() sono organizzati come D(0 To N_C - 1);
'   gli NFre_C + 1 dati nei vettori Re_C() e Im_C() sono organizzati come
'   Vettore(0 To NFre_C).
'
'   Ver: 22/05/2007 per MAutoCorr_FT e MMutuaCorr_FT.
'
DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
DimN1&,N2&,N4&,N8&,NN&,It&
DimXT#,R1#,t1#,T2#,T3#,T4#,T5#,T6#
DimCC1#,SS1#,CC3#,SS3#,NFreq#
'
If(N_C=1)ThenExitSub
'
' Sposto i dati di ingresso nel vettore D1_C() per non distruggerli
' e per avere un vettore a base 1 come richiesto da questa routine:
CopyMemoryD1_C(1),d(0),8*N_C
'
N1=ITAB_C(1)
ForK=2ToN1
I0=N1*ITAB_C(K)+1
I=K
J=I0
ForIt=2ToITAB_C(K)+1
XT=D1_C(I)
D1_C(I)=D1_C(J)
D1_C(J)=XT
I=I+N1
J=I0+ITAB_C(It)
NextIt
NextK
'
Ic=1
ID=4
70
ForI0=IcToN_CStepID
I1=I0+1
R1=D1_C(I0)
D1_C(I0)=R1+D1_C(I1)
D1_C(I1)=R1-D1_C(I1)
NextI0
'
Ic=2*ID-1
ID=4*ID
If(Ic<N_C)ThenGoTo70
'
N2=2
NN=N_C/2
ForK=2ToMM_C
N2=N2*2
N4=N2/4
N8=N2/8
NN=NN/2
Ic=0
ID=N2*2
40
ForI=IcToN_C-1StepID
I1=I+1
I2=I1+N4
I3=I2+N4
I4=I3+N4
t1=D1_C(I4)+D1_C(I3)
D1_C(I4)=D1_C(I4)-D1_C(I3)
D1_C(I3)=D1_C(I1)-t1
D1_C(I1)=D1_C(I1)+t1
If(N4=1)ThenGoTo38
I1=I1+N8
I2=I2+N8
I3=I3+N8
I4=I4+N8
t1=(D1_C(I3)+D1_C(I4))/Sqr2
T2=(D1_C(I3)-D1_C(I4))/Sqr2
D1_C(I4)=D1_C(I2)-t1
D1_C(I3)=-D1_C(I2)-t1
D1_C(I2)=D1_C(I1)-T2
D1_C(I1)=D1_C(I1)+T2
38'CONTINUE
NextI
'
Ic=2*ID-N2
ID=4*ID
If(Ic<N_C)ThenGoTo40
'
ForJ=2ToN8
It=(J-1)*NN
CC1=C1_C(It)
SS1=S1_C(It)
CC3=C3_C(It)
SS3=S3_C(It)
Ic=0
ID=2*N2
36
ForI=IcToN_C-1StepID
I1=I+J
I2=I1+N4
I3=I2+N4
I4=I3+N4
I5=I+N4-J+2
I6=I5+N4
I7=I6+N4
I8=I7+N4
t1=D1_C(I3)*CC1+D1_C(I7)*SS1
T2=D1_C(I7)*CC1-D1_C(I3)*SS1
T3=D1_C(I4)*CC3+D1_C(I8)*SS3
T4=D1_C(I8)*CC3-D1_C(I4)*SS3
T5=t1+T3
T6=T2+T4
T3=t1-T3
T4=T2-T4
T2=D1_C(I6)+T6
D1_C(I3)=T6-D1_C(I6)
D1_C(I8)=T2
T2=D1_C(I2)-T3
D1_C(I7)=-D1_C(I2)-T3
D1_C(I4)=T2
t1=D1_C(I1)+T5
D1_C(I6)=D1_C(I1)-T5
D1_C(I1)=t1
t1=D1_C(I5)+T4
D1_C(I5)=D1_C(I5)-T4
D1_C(I2)=t1
NextI
'
Ic=2*ID-N2
ID=4*ID
If(Ic<N_C)ThenGoTo36
NextJ
NextK
'
' Sistemo i valori calcolati in D1_C()
' nei vettori Re_C(), Im_C():
'    For I = 0 To NFre_C - 1
'        Re_C(I) = D1_C(I + 1)
'    Next I
CopyMemoryRe_C(0),D1_C(1),8*(NFre_C+1)
'
ForI=1ToNFre_C-1
Im_C(I)=D1_C(N_C-I+1)
NextI
'
'   ... End of subroutine SFFTBF ...
'
EndSub
PublicSubSFFTBI(ByValNAsLong)
'
'   SFFTBI( N, MM, S1, C1, S3, C3, ITAB )
'
'   Table initialization routine for SFFTBF and SFFTBB
'
'   Usage: CALL SFFTBI( N, MM, S1, C1, S3, C3, ITAB )
'   Parameters:
'    N - integer length of transform (must be a power of two)
'    MM - integer such that N = 2**MM
'    S1 - array of sin() table (length >= n/8-1)
'    C1 - array of cos() table (length >= n/8-1)
'    S3 - array of sin() table (length >= n/8-1)
'    C3 - array of cos() table (length >= n/8-1)
'    ITAB - integer bit reversal table (length >= sqrt(2n))
'
'   Uses standard FORTRAN programs - sin, cos
'
'   Steve Kifowit, 26 June 1997
'
'   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
'
'   I valori calcolati nei vettori S1(), C1(), S3(), C3() e ITAB() ed MM
'   non vengono ritornati da questa routine ma memorizzati localmente
'   per essere, successivamente, usati da SFFTBF.
'
'
'
DimI&,K&,IMax&,M2&,MS&
DimANG#,t#,u#
'
ReDimS1(1ToN/8-1),C1(1ToN/8-1)
ReDimS3(1ToN/8-1),C3(1ToN/8-1)
ReDimITAB(1ToSqr(2*N))
ReDimD1(1ToN)
'
MM=CLng(Log(CDbl(N))/Log2)
'
'   ... Compute bit reversal table ...
M2=Int(MM/2)
MS=2^M2
If(2*M2<>MM)ThenM2=M2+1
ITAB(1)=0
ITAB(2)=1
IMax=1
ForK=2ToM2
IMax=2*IMax
ForI=1ToIMax
ITAB(I)=2*ITAB(I)
ITAB(I+IMax)=1+ITAB(I)
NextI
NextK
ITAB(1)=MS
'
'   ... Quick return ...
If(N<=8)ThenExitSub
'
'   ... Compute trig tables ...
ANG=PI2/CDbl(N)
K=N/8-1
ForI=1ToK
t=ANG*CDbl(I)
C1(I)=Cos(t)
S1(I)=Sin(t)
u=3#*t
C3(I)=Cos(u)
S3(I)=Sin(u)
NextI
'
'   ... End of subroutine SFFTBI ...
'
EndSub
PublicSubSFFTBI_Corr(ByValN1AsLong,OptionalByValN2AsLong=-1)
'
'   SFFTBI( N, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C )
'
'   Table initialization routine for SFFTBF_Corr and SFFTBB_Corr
'
'   Usage: CALL SFFTBI( N, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C )
'   Parameters:
'    N1     - integer length of 1° data vector.
'    N2     - integer length of 2° data vector.
'    N_C    - integer length of transform (is a power of two).
'    MM_C   - integer such that N_C = 2**MM_C.
'    S1_C   - array of sin() table (length >= n/8-1).
'    C1_C   - array of cos() table (length >= n/8-1).
'    S3_C   - array of sin() table (length >= n/8-1).
'    C3_C   - array of cos() table (length >= n/8-1).
'    ITAB_C - integer bit reversal table (length >= sqrt(2n)).
'
'   Uses standard FORTRAN programs - sin, cos
'
'   Steve Kifowit, 26 June 1997
'
'   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
'
'   I valori calcolati nei vettori S1_C(), C1_C(), S3_C(), C3_C(), ITAB_C()
'   e nelle variabili N_C, MM_C non vengono ritornati da questa routine ma
'   memorizzati localmente per essere, successivamente, usati da SFFTBF_Corr
'   e SFFTBB_Corr.
'
'   Versione per AudioCardDSP (22/05/2007) da usare con MAutoCorr_FT
'   e MMutuaCorr_FT.
'
DimI&,K&,IMax&,M2&,MS&
DimOmSh#,ANG#,t#,u#
'
N1_C=N1
If(N2=-1)Then
N2_C=N1
Else
N2_C=N2
EndIf
'
MM_C=CLng(Ceil(Log(CDbl(N1_C+N2_C-1))/Log2))
N_C=2^MM_C
NFre_C=N_C/2
'
ReDimS1_C(1ToN_C/8-1),C1_C(1ToN_C/8-1)
ReDimS3_C(1ToN_C/8-1),C3_C(1ToN_C/8-1)
ReDimITAB_C(1ToSqr(2*N_C))
ReDimD1_C(1ToN_C)
ReDimRe1_C(0ToNFre_C),Im1_C(0ToNFre_C)
ReDimRe2_C(0ToNFre_C),Im2_C(0ToNFre_C)
ReDims(0ToNFre_C),f(0ToNFre_C)
ReDimWnRe(0ToNFre_C),WnIm(0ToNFre_C)
'
' Calcolo le tavole dei seni/coseni per
' la trasformata del segnale ritardato
' di N1_C campioni (solo per AutoCorr_FT):
OmSh=PI2*N1_C/N_C
ForI=0ToNFre_C
WnRe(I)=Cos(OmSh*I)
WnIm(I)=-Sin(OmSh*I)
NextI
'
'   ... Compute bit reversal table ...
M2=Int(MM_C/2)
MS=2^M2
If(2*M2<>MM_C)ThenM2=M2+1
ITAB_C(1)=0
ITAB_C(2)=1
IMax=1
ForK=2ToM2
IMax=2*IMax
ForI=1ToIMax
ITAB_C(I)=2*ITAB_C(I)
ITAB_C(I+IMax)=1+ITAB_C(I)
NextI
NextK
ITAB_C(1)=MS
'
'   ... Quick return ...
If(N_C<=8)ThenExitSub
'
'   ... Compute trig tables ...
ANG=PI2/CDbl(N_C)
K=N_C/8-1
ForI=1ToK
t=ANG*CDbl(I)
C1_C(I)=Cos(t)
S1_C(I)=Sin(t)
u=3#*t
C3_C(I)=Cos(u)
S3_C(I)=Sin(u)
NextI
'
'   ... End of subroutine SFFTBI ...
'
EndSub

PublicSubLeggiCoefficienti_IIR(ByRefNK_UAsLong,ByRefNCel_UAsLong,_
ByRefW_U()AsSingle,ByRefAc_U()AsSingle,ByRefBc_U()AsSingle)
'
'   Con questa routine e' possibile ritornare, per uso locale, i
'   coefficienti di un filtro IIR calcolati precedentemente dalla
'   Function SintesiIIR_BT():
'
'   Routine usata in AudioCardDSP (27/04/2009)
'
NK_U=NK' Ordine
NCel_U=NCel' e numero di sezioni del filtro.
W_U()=w()' Registri delle sezioni del filtro.
Ac_U()=Ac()' Coefficienti del filtro.
Bc_U()=Bc()'"""
'
'
'
EndSub
PublicSubLeggiCoefficienti_SPM_R(ByRefSn_1_UAsComplex,ByRefSmRE_U()AsDouble,_
ByRefz1_1_UAsComplex,ByRefz1_N_UAsComplex,ByRefNormSpm_UAsDouble)
'
'   Con questa routine e' possibile ritornare, per uso locale, i
'   coefficienti di un filtro SPM_R calcolati precedentemente dalla
'   Sub SPM_MF_R_Init():
'
'   Routine usata in AudioCardDSP (27/04/2009)
'
Sn_1_U=Sn_1' Sn * Z^-1
SmRE_U()=SmRE()' Registro a scorrimento dei campioni del segnale.
z1_1_U=z1_1' z1(0)^-1
z1_N_U=z1_N' z1(0)^-N
NormSpm_U=NormSpm' Fattore di normalizzazione sul N° di campioni.
'
'
'
EndSub