!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Sergio Steffe' - Laboratorio Sperimentale di Matematica Computazionale
! Dipartimento di Matematica - Universita' di Pisa - AA 2002/2003
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
program muovi
!
!!!!!!!!!!!!!!! descrizione !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!punto che si muove lineramente emettendo una suono dato
!mono assegnato in un file di ingresso
!formato di uscita: (16bit big endian stereo PCM)
!
!!!!!!!!!!!!!!! dichiarazioni !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
IMPLICIT NONE
!
!
INTEGER,PARAMETER ::  iduemax=32767
!mi tengo sotto il minimo valore 32767 per non avere guai con l'arrotondamento
!
!
!2 pi greco
DOUBLE PRECISION pi2
!
!frequenza di campionamento
DOUBLE PRECISION  fsample
!
!velocita' del suono
DOUBLE PRECISION  csound
!
!semidistanza orecchie
DOUBLE PRECISION delta
!
!distanza della retta
DOUBLE PRECISION dretta,b
!
!velocita del punto
DOUBLE PRECISION vp
!
!coordinate del punto all'istante t
!DOUBLE PRECISION xp,yp
!
!distanze dalle orecchie
DOUBLE PRECISION dds, dsn
!
!tempi di generazione del segnale ai due orecchi
!DOUBLE PRECISION tds,tsn
!
!
!durata totale del suono
DOUBLE PRECISION TTOT
!
!numero capionature disponibili
INTEGER NTOT
!
!ampiezza del suono generato
DOUBLE PRECISION :: amp=1.0
!
!
!nome del file di input
CHARACTER(len=64) FILENAMEIN
!
!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
CHARACTER(len=20) FILENAME1
!
!errore in i/o
INTEGER                                 :: ioerr
!
!contatore principale del generatore del suono
INTEGER I,kk
!
!istante di tempo 
DOUBLE PRECISION t
!
!segnale sonoro a ds e sn in scala arbitraria tra -1 e +1
DOUBLE PRECISION soundds,soundsn
!
!interi usati per conversioni da real a intero due bytes big little endian
INTEGER(2) iids,iisn,ii,jj
!
!reali usati per i calcoli
DOUBLE PRECISION tt,aa,bb,cc
!
!
!!!!!!!!!!!!!! assegnazione delle variabili !!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
!
!
write(*,*)'Velocita (m/sec):'
read(*,*)vp
write(*,*)'hai detto: ',vp
!
write(*,*)'distanza della retta(m):'
read(*,*)dretta
write(*,*)'hai detto: ',dretta
!
write(*,*)'posizione iniziale (negativo= a sinistra)'
read(*,*)b
write(*,*)'hai detto: ',b
!
!
!!!!!!!!!!!!!!calcola lunghezza del file di ingresso!!!!!!!!!!!!!!!!!!!
!
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

!!!!!!!!!!!!!! inizio calcoli !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!si apre il file
!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)
!
!setup delle variabili
!
pi2=8*atan(1.0)
fsample=44100.0
csound=330.0
!
delta=0.1
!
!la distanza minima e' dretta
amp = dretta
!
!
!loop principale
!
do I=1,NTOT
!istante di tempo
t=i
t=t/fsample 
!
! al momento t il punto si trova in 
! x(t)=b+vp*t e y(t)=dretta ed ha distanza
! dds(t)=sqrt((x+dretta)^2+y^2) e dsn(t)=sqrt((x-dretta)^2+y^2) dalle orecchie.
! le onde impiegano dei tempi dds(t)/csound e dsn(t)/csound
! per arrivare agli orecchi in istanti t+tds t t+tsn
! dato t+tds si deve calcolare tds e poi dds
! dato t+tsn si deve calcolare tsn e poi dsn
! 
aa=t*csound**2+(b+delta)*vp
bb=(t*csound)**2 -(b+delta)**2 -dretta**2
cc=csound**2-vp**2
tt=(aa-sqrt(aa**2-cc*bb))/cc
dds=sqrt(dretta**2+(b+delta+vp*tt)**2)
!convertire tt in indice
if (tt < 0.0) then
soundds=0.0
else
kk=tt*fsample
if (kk > ntot) then
soundds=0.0
else
read(11,rec=kk,IOSTAT=ioerr)ii,jj
call MVBITS(ii,0,8,iids,8)
call MVBITS(ii,8,8,iids,0)
soundds=iids
soundds=amp*soundds/dds
endif
endif
!
!
aa=t*csound**2+(b-delta)*vp
bb=(t*csound)**2 -(b-delta)**2 -dretta**2
cc=csound**2-vp**2
tt=(aa-sqrt(aa**2-cc*bb))/cc
dsn=sqrt(dretta**2+(b-delta+vp*tt)**2)
!convertire tt in indice
if (tt < 0.0) then
soundsn=0.0
else
kk=tt*fsample
if (kk > ntot) then
soundsn=0.0
else
read(11,rec=kk,IOSTAT=ioerr)ii,jj
call MVBITS(jj,0,8,iisn,8)
call MVBITS(jj,8,8,iisn,0)
soundsn=iisn
soundsn=amp*soundsn/dsn
endif
endif
ii=NINT(soundds)
call MVBITS(ii,0,8,iids,8)
call MVBITS(ii,8,8,iids,0)
jj=NINT(soundsn)
call MVBITS(jj,0,8,iisn,8)
call MVBITS(jj,8,8,iisn,0)
!
write(10,rec=i) iids,iisn
end do
!
close(10)
close(11)
!
ttot=i
ttot=ttot/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 muovi
