Initial Commit

.svn/pristine/03/036e4020315e2a81cb0a90c1093eab9c8eb268b2.svn-base

@@ -0,0 +1,71 @@
+!
+! readwav - open and read the header of a WAV format file
+!
+! On successful exit the file is left positioned at the start of the
+! data.
+!
+! Example of usage:
+!
+!  use readwav
+!  integer*2 sample
+!  type(wav_header) wav
+!  call wav%read ('file.wav')
+!  write (*,*) 'Sample rate is: ', wav%audio_format%sample_rate
+!  do i=0,wav%data_size
+!    read (unit=wav%lun) sample
+!    ! process sample
+!  end do
+!
+module readwav
+  implicit none
+
+  type format_chunk
+     integer*2 audio_format
+     integer*2 num_channels
+     integer sample_rate
+     integer byte_rate
+     integer*2 block_align
+     integer*2 bits_per_sample
+  end type format_chunk
+  
+  type, public :: wav_header
+     integer :: lun
+     type(format_chunk) :: audio_format
+     integer :: data_size
+   contains
+     procedure :: read
+  end type wav_header
+
+  private
+contains
+  subroutine read (this, filename)
+    implicit none
+
+    type riff_descriptor
+       character(len=4) :: id
+       integer :: size
+    end type riff_descriptor
+
+    class(wav_header), intent(inout) :: this
+    character(len=*), intent(in) :: filename
+
+    integer :: filepos
+    type(riff_descriptor) :: desc
+    character(len=4) :: riff_type
+
+    open (newunit=this%lun, file=filename, access='stream', form='unformatted', status='old')
+    read (unit=this%lun) desc,riff_type
+    inquire (unit=this%lun, pos=filepos)
+    do
+       read (unit=this%lun, pos=filepos) desc
+       inquire (unit=this%lun, pos=filepos)
+       if (desc%id .eq. 'fmt ') then
+          read (unit=this%lun) this%audio_format
+       else if (desc%id .eq. 'data') then
+          this%data_size = desc%size
+          exit
+       end if
+       filepos = filepos + (desc%size + 1) / 2 * 2 ! pad to even alignment
+    end do
+  end subroutine read
+end module readwav