!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Sergio Steffe' - Laboratorio Sperimentale di Matematica Computazionale
! Dipartimento di Matematica - Universita' di Pisa - AA 2002/2003
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
program filtrofir
!
!!!!!!!!!!!!!!!!!!! descrizione !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! esempio di filtraggio usando un filtro FIR
! 
! i files sonori sono  stereo 16 bit PCM big endian 44100Hz
! i dati del filtro sono nel file dati.fir
! vengono supposti 0 i dati "prima" dell'inizio del file
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
IMPLICIT NONE
!
INTEGER,PARAMETER 				::  iduemax=32767
!mi tengo sotto il minimo valore 32767 per non avere guai con l'arrotondamento
!
!frequenza di campionamento
DOUBLE PRECISION 				:: fsample=44100.0
!
!numero punti del filtro FIR e loro valori
INTEGER                                         :: nfir
DOUBLE PRECISION,DIMENSION(:),ALLOCATABLE       :: firfiltro
!
!buffer valori canali ds e sn e puntatore del FIFO per i calcoli
DOUBLE PRECISION,DIMENSION(:),ALLOCATABLE	:: bufferds,buffersn
INTEGER						:: puntatore
!
!riduzione ampiezza e massimo segnale in uscita
DOUBLE PRECISION				:: amp, maxamp
!
!numero campionature
!INTEGER 					:: ntot
!
!posizione
INTEGER 					:: posin
!
!interi usati per contatori
INTEGER 					:: i,k,overflow
!
!tempo totale
DOUBLE PRECISION  				:: ttot
!
!segnale sonoro a ds e sn
DOUBLE PRECISION 				:: soundds,soundsn
!
!interi usati per conversioni da real a intero due bytes big little endian
INTEGER(2)  					:: iids,iisn,ii,jj
!
!nomi del file di  output
CHARACTER(len=25) FILENAMEOUT
!
!posfisso da aggiungere al nome file di output
CHARACTER(len=4) :: POSTF='.cdr'
!
!variabile per lettura nome file 
CHARACTER(len=20) FILENAME1
!
!nome del file di input
CHARACTER(len=64) FILENAMEIN
!
!errore in lettura file
INTEGER						:: ioerr
!
!!!!!!!!!!!!!!!!!!!!!!!! inizio !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!si aprono i files
!REPLACE crea o cancella se esistente
!UNFORMATTED usa formato interno per salvare i dati
!DIRECT usa l'accesso ad un qualsiasi record
!RECL e' la lunghezza di ogni record (4 bytes)
!
!per primo il file dei dati del filtro
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!Il file dati.fir contiene nfir dati del filtro - se non c'e esci!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
open(unit=12,file='dati.fir',status='OLD',ERR=101)
read(12,*) nfir
ALLOCATE(firfiltro(nfir))
do i=1,nfir
read(12,*)firfiltro(i)
end do
close(12)
!
write(*,*)'Letto dal file dati.fir i ',nfir,' coefficienti del filtro'
!
!
write(*,*)'Nome del file di input:'
read(*,*)FILENAMEIN
!write(*,*)'hai detto: ',FILENAMEIN
!
open(unit=11,file=FILENAMEIN,status='OLD',form='UNFORMATTED',access='DIRECT',RECL=4,ERR=102)
!
write(*,*)'Nome del file di output (max 20 char senza spazi): '
read(*,*) FILENAME1
FILENAMEOUT = FILENAME1(1:SCAN( FILENAME1,' ',.FALSE.)-1)//POSTF
!write(*,*)'hai detto: ',FILENAMEOUT
!
open(unit=10,file=FILENAMEOUT,status='REPLACE',form='UNFORMATTED',access='DIRECT',RECL=4)
!
write(*,*)'fattore di riduzione tra 0.0 e 1.0, default 1.0 : '
read(*,*) amp
if ((amp < 0.0).or.(amp > 1.0)) then
amp=1.0
end if
!
!!!!!!!!!!!!!!!!!!!inizio elaborazione!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
overflow=0
maxamp=0
!
ALLOCATE(bufferds(nfir))
ALLOCATE(buffersn(nfir))
!
bufferds=0.0D0
buffersn=0.0D0
!
puntatore=nfir
!
posin=1
!
!ripeti fino alla fine del file
do while(1==1)
!!!!!!!!!!!!!!!!!!!leggi un nuovo record!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
read(unit=11,rec=posin,IOSTAT=ioerr)ii,jj
IF (ioerr /= 0) EXIT
call MVBITS(ii,0,8,iids,8)
call MVBITS(ii,8,8,iids,0)
call MVBITS(jj,0,8,iisn,8)
call MVBITS(jj,8,8,iisn,0)
!
!!!aggiorna il puntatore del FIFO scartando la posizione piu vecchia
if (puntatore == nfir) then
	puntatore=1
else
	puntatore=puntatore + 1
endif
!
!!!!!!!!!!!inserisci i dati nel loro posto nel FIFO!!!!!!!!!!!!!!!!!!
bufferds(puntatore)=iids
buffersn(puntatore)=iisn
!
!!!!!!!!!!!!!!!!!!!!!!calcola le convoluzioni!!!!!!!!!!!!!!!!!!!!!!!!
soundds=0
soundsn=0
k=puntatore
do i=1,nfir
soundds=soundds+firfiltro(i)*bufferds(k)
soundsn=soundsn+firfiltro(i)*buffersn(k)
if (k == 1) then
 k=nfir
else
 k=k-1
endif
end do
!
!calcola il massimo valore
if (maxamp < abs(soundds)) then
maxamp=abs(soundsn)
endif
if (maxamp < abs(soundsn)) then
maxamp=abs(soundsn)
endif
!
!scalatura del livello come da richiesta
soundds=soundds*amp
soundsn=soundsn*amp
!
!
!controllo dell'overflow
if (soundds> iduemax) then
soundds = iduemax
overflow=overflow+1
endif
if (soundds < -iduemax) then
soundds = -iduemax
overflow=overflow+1
endif
if (soundsn > iduemax) then
soundsn = iduemax
overflow=overflow+1
endif
if (soundsn < -iduemax) then
soundsn = -iduemax
overflow=overflow+1
endif
!
!!!!!!!!!!!!!!!!!scrivi il dato nel file di output!!!!!!!!!!!!!!!!!!!!!!!!
ii=NINT(soundds)
jj=NINT(soundsn)
call MVBITS(ii,0,8,iids,8)
call MVBITS(ii,8,8,iids,0)
call MVBITS(jj,0,8,iisn,8)
call MVBITS(jj,8,8,iisn,0)
!
write(unit=10,rec=posin) iids,iisn
!
!!!!!!!!!!!!!!!!!!!incrementa il contatore della posizione!!!!!!!!!!!!!!!!
posin=posin+1
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end do

ttot=posin-1
ttot=ttot/fsample
write(*,*)'Scritti ',ttot,' secondi di audio sul file ',FILENAMEOUT
!
!warning dell'overflow
if (overflow > 0) then
write(*,*)'WARNING: overflow nella scrittura del file ! ',overflow,' volte.'
write(*,*)'Il fattore di riduzione raccomandato risulta ',iduemax/maxamp
endif
!
!bypass alla fine del programma
GOTO 200
!
!gestione degli errori sui files
!
101 write(*,*)'ERRORE aprendo in lettura il file: dati.fir'
GOTO 200
!
102 write(*,*)'ERRORE aprendo in lettura il file: ',FILENAMEIN
GOTO 200
!
104 write(*,*)'ERRORE aprendo in scrittura il file: ',FILENAMEOUT
GOTO 200
!
200 CONTINUE
!
end program filtrofir
