!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Sergio Steffe' - Laboratorio Sperimentale di Matematica Computazionale
! Dipartimento di Matematica - Universita' di Pisa - AA 2002/2003
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
program echo1
!
!!!!!!!!!!!!!!!!!!! descrizione !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! esempio di unita' echo e riverbero
! 
! i files sonori sono  stereo 16 bit PCM big endian 44100Hz
! il file  dati.echo contiene il numero di echo e per ciascun echo
! delay (in secondi) e ampiezza  (somma 1.0)           
! il primo dato deve avere delay=0.0 
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
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 di echo e loro valori, max delay e grandezza buffer
INTEGER                                         :: necho
DOUBLE PRECISION,DIMENSION(:),ALLOCATABLE       :: delayecho,ampecho
INTEGER,DIMENSION(:),ALLOCATABLE		:: puntecho
DOUBLE PRECISION				:: maxdelay
INTEGER						:: nn
!
!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
!
!numero campionature
!INTEGER 					:: ntot
!
!posizione
INTEGER 					:: posin
!
!interi usati per contatori
INTEGER 					:: i,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 dei ritardi
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!Il file dati.echo contiene i ritardi - se non c'e esci!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
open(unit=12,file='dati.echo',status='OLD',ERR=101)
read(12,*) necho
ALLOCATE(delayecho(necho))
ALLOCATE(ampecho(necho))
ALLOCATE(puntecho(necho))
do i=1,necho
read(12,*)delayecho(i),ampecho(i)
end do
close(12)
!
write(*,*)'Letto dal file dati.echo i ',necho,' dati dei ritardi'
!
!controllo che la somma delle ampecho sia  1.0 e senno si riscala..
amp=0.0
do i=1,necho
ampecho(i)=abs(ampecho(i))
delayecho(i)=abs(delayecho(i))
amp=amp+ampecho(i)
end do
ampecho=ampecho/amp
!
! calcolo del massimo delay
maxdelay=0.0
do i=1,necho
if (maxdelay < delayecho(i)) then
maxdelay = delayecho(i)
endif
enddo
!
!il buffer deve contenere dati per maxdelay secondi + 1 di guardia
nn=maxdelay*fsample + 1.5
!
!
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)
!
!
!!!!!!!!!!!!!!!!!!!inizio elaborazione!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
overflow=0
!
ALLOCATE(bufferds(nn))
ALLOCATE(buffersn(nn))
!
bufferds=0.0D0
buffersn=0.0D0
!
puntatore=nn
!
!calcolo degli indici dei delay
do i=1, necho
puntecho(i)=nn - (delayecho(i)*fsample +0.5) 
puntecho(i)=puntecho(i)+1
end do
!
!
posin=1
!
!ripeti fino alla fine del file
do while(1==1)
!!!!!!!!!!!!!!!!!!!leggi un nuovo record!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
read(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 == nn) then
	puntatore=1
else
	puntatore=puntatore + 1
endif
!
!!!!!!!!!!!inserisci i dati nel loro posto nel FIFO!!!!!!!!!!!!!!!!!!
bufferds(puntatore)=iids
buffersn(puntatore)=iisn
!
!!!aggiorna i puntatori alle posizioni dei delay!!!!!!!!!!!!!!!!!!!!!
do i=1,necho
if (puntecho(i) == nn) then
        puntecho(i)=1
else
        puntecho(i)=puntecho(i) + 1
endif
end do
!!!!!!!!!!!!!!!!!!!somma gli echi coi ritardi richiesti!!!!!!!!!!!!!!!!!!!
soundds=0
soundsn=0
do i=1,necho
soundds=soundds+ampecho(i)*bufferds(puntecho(i))
soundsn=soundsn+ampecho(i)*buffersn(puntecho(i))
end do
!
!
!!!!!!!!!!!!!!!!!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(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
!
!bypass alla fine del programma
GOTO 200
!
!gestione degli errori sui files
!
101 write(*,*)'ERRORE aprendo in lettura il file: dati.echo'
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 echo1
