C Programma per l'estrazione da un file B-format (4 canali) di un file WAV mono corrispondente ad un microfono
C direttivo virtuale puntato ina prescelta direzione
C      Program VirtualMike
      Include 'flib.fi'
      Include 'flib.fd'
      Character*80 Outfile,Infile1,Infile2,Ref
      CHARACTER RIFF*4,FMT*8,DAT*4,AA*20
      INTEGER*4 FILELEN,BOH,FSAMP,BYTERATE,NBYTES,i
      INTEGER*4 FILELEN2,FSAMP2,BYTERATE2
      INTEGER*2 UNO,NoutCHANN,BYTESxPOINT,BITSxWORD,NinCHANN,NinCHANN2
	INTEGER*2 BITSxWORD2
      INTEGER*4 N,Nblocks
	REAL*4 W(16384),X(16384),Y(16384),Z(16384),Vl(16384),Vr(16384)
	INTEGER*2 Wint(16384),Xint(16384),Yint(16384),Zint(16384)
	INTEGER*2 Vlint(16384),Vrint(16384)
	Character Buffer*20
      write(6,1)
    1 format('*** Virtual Mike 2 - Converts 2 2-channels B-format Files',
     1' to a stereo WAV file ***',/)    
      write (6,2)
    2 format(1x,'    Copyright (2001) by Angelo Farina - University of',
     1' Parma (Italy)',/)
      CHR0=0
	Len=0
      Narg=NARGS()
      IF (Narg.LT.7) THEN
         Write(6,'(1H ,37HName of the WX 4channels .WAV file = ,\)')
         Read(5,'(A40)')Infile1
         Write(6,'(1H ,37HName of the YZ 4channels .WAV file = ,\)')
         Read(5,'(A40)')Infile2
         Write(6,'(1H ,37HName of the stereo WAV output file = ,\)')
         Read(5,'(A40)')Outfile
         Write(6,'(1H ,37HDirectivity Factor (0..2)          = ,\)')
         Read(5,*)D
         Write(6,'(1H ,41HSelect Angular (A) or Cartesian (C) ref.:,\)')
         Read(5,'(A40)')Ref
	   if ((Ref(1:1).eq.'A').or.(Ref(1:1).eq.'a')) then
		   Write(6,'(1H ,28HAzimut    Angle (degrees) = ,\)')
		   Read(5,*)Azimut
		   Write(6,'(1H ,28HElevation Angle (degrees) = ,\)')
		   Read(5,*)Elevation
		   pi=2.0*asin(1.0)
		   Xcoord=cos(Azimut/180.0*pi)*cos(Elevation/180.0*pi)
		   Ycoord=sin(Azimut/180.0*pi)*cos(Elevation/180.0*pi)
		   Zcoord=sin(Elevation/180.0*pi)
	   else
		   Write(6,'(1H ,15HX coordinate = ,\)')
		   Read(5,*)Xcoord
		   Write(6,'(1H ,15HY coordinate = ,\)')
		   Read(5,*)Ycoord
		   Write(6,'(1H ,15HZ coordinate = ,\)')
		   Read(5,*)Zcoord
	   end if
      ELSE
         call GetArg(1,InFile1,Len)
         Write(6,'(37HFile Name of the WX 4channels file = ,A40)')
     1   InFile1
         call GetArg(2,InFile2,Len)
         Write(6,'(37HFile Name of the YZ 4channels file = ,A40)')
     1   InFile2
         call GetArg(3,OutFile,Len)
         Write(6,'(37HFile Name of the  .WAV output file = ,A40)')
     1   OutFile
	   call GetArg(4,AA,Len)
	   Write(6,'(39HDirectivity Factor (0..2)            = ,A40)') AA
	   write(Buffer,'(A20)') AA
	   read(Buffer,*) D
         call GetArg(5,Ref,Len)
	   if ((Ref(1:1).eq.'A').or.(Ref(1:1).eq.'a')) then
		   call GetArg(6,AA,Len)
		   write(Buffer,'(A20)') AA
		   read(Buffer,*) Azimut
		   Write(6,'(28HAzimut    Angle (degrees) = ,F12.3)')Azimut
		   call GetArg(7,AA,Len)
		   write(Buffer,'(A20)') AA
		   read(Buffer,*) Elevation
		   Write(6,'(28HElevation Angle (degrees) = ,F12.3)')Elevation
		   pi=2.0*asin(1.0)
		   Xcoord=cos(Azimut/180.0*pi)*cos(Elevation/180.0*pi)
		   Ycoord=sin(Azimut/180.0*pi)*cos(Elevation/180.0*pi)
		   Zcoord=sin(Elevation/180.0*pi)
	   else
		   call GetArg(6,AA,Len)
		   write(Buffer,'(A20)') AA
		   read(Buffer,*) Xcoord
		   Write(6,'(15HX coordinate = ,F12.3)') Xcoord
		   call GetArg(7,AA,Len)
		   write(Buffer,'(A20)') AA
		   read(Buffer,*) Ycoord
		   Write(6,'(15HY coordinate = ,F12.3)') Ycoord
		   call GetArg(8,AA,Len)
		   write(Buffer,'(A20)') AA
		   read(Buffer,*) Zcoord
		   Write(6,'(15HZ coordinate = ,F12.3)') Zcoord
		end if
      END IF 
C Normalizzazione coordinate puntamento microfono virtuale
	Den=sqrt(Xcoord*Xcoord+Ycoord*Ycoord+Zcoord*Zcoord)
	Xcoord=Xcoord/Den
	Ycoord=Ycoord/Den
	Zcoord=Zcoord/Den
	        
C Apro i files di Input e di Output
      Open(Unit=1,Form='BINARY',File=Infile1,Mode='READ',Status='OLD')
      read(1)RIFF,FILELEN,FMT
      READ(1)BOH,UNO,NinCHANN
      if (NinCHANN.NE.2) then
         Write(6,*)'ERROR - The input file must be 2-channels'
         STOP
      END IF
      READ(1)FSAMP,BYTERATE
      READ(1)BYTESxPOINT,BITSxWORD,DAT,NBYTES
c      DO WHILE (DAT.ne.'data')
c         read(1)(dummybyte,i=1,NBYTES)
c         READ(1)DATA,NBYTES
c      END DO   
      N=NBYTES/BYTESxPOINT
C     N è il numero di punti da leggere del file .WAV
      write(6,*) 'Number of data points #1 :',N,' with ',NinCHANN,
     1' Channels'
      write(6,*) 'Sampling Frequency #1 (Hz):',Fsamp,' with ',
     1BitsxWord,' Bits' 

      Open(Unit=2,Form='BINARY',File=Infile2,Mode='READ',Status='OLD')
      read(2)RIFF,FILELEN,FMT
      READ(2)BOH,UNO,NinCHANN
      if (NinCHANN.NE.2) then
         Write(6,*)'ERROR - The input file must be 2-channels'
         STOP
      END IF
      READ(2)FSAMP,BYTERATE
      READ(2)BYTESxPOINT,BITSxWORD,DAT,NBYTES
c      DO WHILE (DAT.ne.'data')
c         read(1)(dummybyte,i=1,NBYTES)
c         READ(1)DATA,NBYTES
c      END DO   
      N=NBYTES/BYTESxPOINT
C     N è il numero di punti da leggere del file .WAV
      write(6,*) 'Number of data points #2 :',N,' with ',NinCHANN,
     1' Channels'
      write(6,*) 'Sampling Frequency #2 (Hz):',Fsamp,' with ',
     1BitsxWord,' Bits' 
	Nblocks=N/16384

 
           
C     Scrittura del file .WAV
      Open(Unit=9,Form='BINARY',File=Outfile,Mode='WRITE')
      Rewind(9)
C     Preparo le costanti
      write(6,139) FSAMP
  139 format(1x,'Outfile Fsampling =',I8,' Hz')
      NoutCHANN=2
      BYTERATE=FSAMP*BYTESxPOINT
      NBYTES=N*BYTESxPOINT
      FILELEN=36+NBYTES
      Write(9) RIFF,FILELEN,FMT
      Write(9) BOH,UNO,NoutCHANN
      Write(9) FSAMP,BYTERATE
      Write(9) BYTESxPOINT,BITSxWORD,DAT,NBYTES

C     Inizio a trasferire i dati
      write (6,'(1h )')
      write(6,11)
   11 format(1x,'Saving data to output file (s)...')
      sq=sqrt(2.0)
      if (BITSxWORD.eq.16) then
		do j=1,Nblocks
		   read(1) (Wint(i),Xint(i),i=1,16384)
		   read(2) (Yint(i),Zint(i),i=1,16384)
		   do i=1,16384
			   W(i)=sq*Wint(i)
			   X(i)=1.0*Xint(i)
			   Y(i)=1.0*Yint(i)
			   Z(i)=1.0*Zint(i)
			   Vl(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)+Ycoord*Y(i)
     1	   			 +Zcoord*Z(i)))
			   Vr(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)-Ycoord*Y(i)
     1				 +Zcoord*Z(i)))
			   Vlint(i)=int(Vl(i))
			   Vrint(i)=int(Vr(i))
		   end do
		   write(9) (Vlint(i),Vrint(i),i=1,16384)
		end do
		do i=1,(N-Nblocks*16384)
			   W(i)=sq*Wint(i)
			   X(i)=1.0*Xint(i)
			   Y(i)=1.0*Yint(i)
			   Z(i)=1.0*Zint(i)
			   Vl(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)+Ycoord*Y(i)
     1	   			 +Zcoord*Z(i)))
			   Vr(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)-Ycoord*Y(i)
     1				 +Zcoord*Z(i)))
			   Vlint(i)=int(Vl(i))
			   Vrint(i)=int(Vr(i))
		end do
	else
		do j=1,Nblocks
		   read(1) (W(i),X(i),i=1,16384)
		   read(2) (Y(i),Z(i),i=1,16384)
		   do i=1,16384
		      W(i)=sq*W(i)
	          Vl(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)+Ycoord*Y(i)
     1		        +Zcoord*Z(i)))
	          Vr(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)-Ycoord*Y(i)
     1		        +Zcoord*Z(i)))
	       end do
		   write(9) (Vl(i),Vr(i),i=1,16384)
		end do
		do i=1,(N-Nblocks*16384)
		   read(1) W(i),X(i)
		   read(2) Y(i),Z(i)
		   W(i)=sq*W(i)
	       Vl(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)+Ycoord*Y(i)
     1	        +Zcoord*Z(i)))
	       Vr(i)=0.5*((2.0-D)*W(i)+D*(Xcoord*X(i)-Ycoord*Y(i)
     1	        +Zcoord*Z(i)))
		   write(9) Vl(i),Vr(i)
		end do
	end if

C Chiusura dei files e fine
      write (6,*) ' Conversion terminated OK !!!!'
      close(1)
	close(2)
	close(9)
      END