!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Sergio Steffe' - Laboratorio Sperimentale di Matematica Computazionale
! Dipartimento di Matematica - Universita' di Pisa - AA 2002/2003
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine aggiungi(x,y,out,in,ntot,delta,ritardo)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! prende il suono di in e lo aggiunge a out proveniente da x,y
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
IMPLICIT NONE
!
!
!numero capionature
INTEGER :: ntot
!
!posizione
DOUBLE PRECISION			::	x,y,delta,ritardo
!
!suono in ingresso ed in uscita
DOUBLE PRECISION, DIMENSION(ntot)	::	in,out
!
!frequenza di campionamento
DOUBLE PRECISION  			::  	fsample=44100.0
!
!velocita suono
DOUBLE PRECISION			::	csound=330.0
!
!indici
INTEGER :: i,k,kk
!
DOUBLE PRECISION	:: dxy,txy
!
! al momento t il punto si trova in x,y con distanza dxy e impiega txy
! ad arrivare all'orecchia posta in delta (+ o - 0.1 m)
! e quindi la ampiezza viene smorzata di 1/dxy
! per tempi negativi in e' zero d'ufficio
!
dxy=sqrt((x-delta)*(x-delta)+(y*y))
txy=dxy/csound + ritardo
kk=txy*fsample 
!puo' essere negativo o positivo
!
do i=1,ntot-2
k=i-kk
if ( 1 < k) then
 if ( k < ntot-2 ) then
   out(i)=out(i)+in(k)/dxy
 end if
end if
end do
!
!write(*,*)x,y,ritardo,dxy*dxy,ntot,kk
end subroutine aggiungi
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program echo3
!
!!!!!!!!!!!!!!! descrizione !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!prende un breve file stereo 16 bit PCM big endian e 
!          crea un file stereo miscelando ripetutamente il file e suoi echo
!
!!!!!!!!!!!!!!! dichiarazioni !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
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
!
!distanza orecchie dal centro testa
DOUBLE PRECISION :: delta=0.1
!
!numero capionature
INTEGER :: i,ntot,k
!
!errore in lettura file: + se errore; 0 se ok; - se end of file
INTEGER ioerr
!
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE	:: suonoin, outds,outsn
DOUBLE PRECISION	:: sds,ssn,x,y,xx,yy,max,ttot,ritardo,caso
!
!nome del file di output
CHARACTER(len=25) FILENAMEOUT
!
!posfisso da aggiungere al nome file
CHARACTER(len=4) :: POSTF='.cdr'
!
!variabile per lettura nome file output
CHARACTER(len=20) FILENAME1
!
!nome del file di input
CHARACTER(len=64) FILENAMEIN
!
!interi usati per conversioni da real a intero due bytes big little endian
INTEGER(2) iids,iisn,ii,jj
!
!
!!!!!!!!!!!!!! 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)
!
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=101)
!
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)
!
!passo 1: si conta la lunghezza del file
!
ntot=0
ioerr=0
i=0
!
DO
i=i+1
read(11,rec=i,IOSTAT=ioerr)ii,jj
IF (ioerr /= 0) EXIT
END DO
!
ntot=i-1
!
!passo 2: si carica in memoria il file (mono)
!
ALLOCATE(suonoin(ntot))
ALLOCATE(outds(ntot))
ALLOCATE(outsn(ntot))
!
ioerr=0
!
do i=1,ntot
read(11,rec=i,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)
sds=iids
ssn=iisn
suonoin(i)=(sds+ssn)/2
end do
close(11)
!
!a questo punto tutto il file e' in memoria.
!
!
!ora accumuliamo per circa 50 posizioni prese a caso 
! ma ad almeno 50cm dall'origine
!con x e y tra -20 e +20 metri (noi siamo al centro)
!il suono generato unito agli echi primi sulle 3 pareti
!       ------------------
!       |                |
!       |                !
!       |                !
!       |                !
!       |                !
!       |                !
!
outds=0.0
outsn=0.0
!
do k=1,200
!
!genera  a caso x e y tra -20 e +20 e ritardo +- ntot/2fsample
!caso tra 0 e 1
call RANDOM_NUMBER(caso)
xx= -20 + 40*caso
call RANDOM_NUMBER(caso)
yy= -20 + 40*caso
if (xx*xx +yy*yy <1.3) then
yy=yy+10.0
endif
call RANDOM_NUMBER(caso)
ritardo= (ntot/(2*fsample))*(-1+2*caso)
!
call aggiungi(xx,yy,outds,suonoin,ntot,delta,ritardo)
call aggiungi(xx,yy,outsn,suonoin,ntot,-delta,ritardo)
!
!ora i 3 echi
x=40.0-xx
y=yy
call aggiungi(x,y,outds,suonoin,ntot,delta,ritardo)
call aggiungi(x,y,outsn,suonoin,ntot,-delta,ritardo)
x=-40.0-xx
y=yy
call aggiungi(x,y,outds,suonoin,ntot,delta,ritardo)
call aggiungi(x,y,outsn,suonoin,ntot,-delta,ritardo)
x=xx
y=40-yy
call aggiungi(x,y,outds,suonoin,ntot,delta,ritardo)
call aggiungi(x,y,outsn,suonoin,ntot,-delta,ritardo)
!
end do

!
!ora normalizziamo la scala
!
max=0
do i=1, ntot
if (max < abs(outds(i)))then
max=abs(outds(i))
endif
end do
do i=1, ntot
if (max < abs(outsn(i)))then
max=abs(outds(i))
endif
end do
!write(*,*) 'max = ',max
do i=1, ntot
outds(i)=outds(i)*(0.8*iduemax/max)
outsn(i)=outsn(i)*(0.8*iduemax/max)
end do
!
! ora scriviamo il file in uscita
!
do i=1,ntot
ii=NINT(outds(i))
jj=NINT(outsn(i))
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=i) iids,iisn
end do
close(10)
!
ttot=ntot/fsample
write(*,501)ttot,FILENAMEOUT
501 FORMAT('Scritti',F5.1,' secondi suono (PCM 2x16 bit big endian) nel file: ',A)
GOTO 202
!
101 write(*,*)'ERRORE aprendo in lettura il file: ',FILENAMEIN
GOTO 202
102  write(*,*)'ERRORE leggendo il file: ',FILENAMEIN
ttot=i
ttot=ttot/fsample
write(*,*)'(dopo ',ttot,' secondi di audio)'

GOTO 202
202 CONTINUE
end program echo3
