wav file 読み取り ミニマル

前回は、Fortran2003の新機能TYPE,EXTENDSを無理に使おうとして、冗長になったので作り直しをば。

■実行結果

入力データは、ネット上に落ちていた2kHzの信号ファイルに、info chunkを手動で入れてみたもの。

サンプリング・レートが44.1kHzなので、2kHzの信号の一周期は44.1/2=22.05〜約22個のデータ点になるはずです。それは出力結果から確認できます。データファイル形式はステレオ2chですが、左右のチャンネルに同じデータが入っており、実質モノラル音声になっています。

■ソース・コード

TYPE中にSEQUENCE文を入れることで、変数の実際のメモリー上の並びが宣言順になります。このとき構造体をREADすると、TYPE中に宣言した変数の順番そのままにデータ読み取りが行われることになります。この機能を用いて、ひとつのREADでWAVファイルのヘッダーを一気に読み取っています。

fmt chunkとdat chunkの間に、別のchunkが入り込むことがあるので（たとえば、WAV編集ソフトがinfo chunkを書き込んだりする）それをスキップするようにしてあります。

MODULE m_kind
  INTEGER, PARAMETER :: kd = SELECTED_REAL_KIND(10, 99) ! 10digits 
END MODULE m_kind

!========================

MODULE m_wavio
  USE m_kind
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: t_wavfile
!
  TYPE :: t_fmt
     SEQUENCE
     CHARACTER(4) :: chunk_id
     INTEGER(4) :: chunk_size
     INTEGER(2) :: format_id, channels
     INTEGER(4) :: sampling_rate
     INTEGER(4) :: bytes_per_sec
     INTEGER(2) :: block_size, bits_per_sample
  END TYPE t_fmt
!
  TYPE :: t_data
     SEQUENCE
     CHARACTER(4) :: chunk_id
     INTEGER(4) :: chunk_size
     ! PCM data 16bit L R
  END TYPE t_data
!
  TYPE :: t_riffwav
     SEQUENCE
     CHARACTER(4) :: chunk_id
     INTEGER(4) :: chunk_size
     CHARACTER(4) :: formattag
     TYPE (t_fmt ) :: fmt
     TYPE (t_data) :: dat
  END TYPE t_riffwav
!
  TYPE :: t_wavfile
     INTEGER :: unit = 10
     INTEGER :: ipos
     CHARACTER(:), ALLOCATABLE :: fn
     TYPE (t_riffwav) :: riff
   CONTAINS
     PROCEDURE :: openfile
     PROCEDURE :: read_pcm
     PROCEDURE :: closefile
     ! FINAL      :: close_file
  END TYPE t_wavfile

 CONTAINS
  !------------------------------------------------
  SUBROUTINE openfile(this, fn)
    CLASS(t_wavfile), INTENT(IN OUT) :: this
    CHARACTER(*), INTENT(IN) :: fn
    INTEGER :: io

    this%fn = fn
    OPEN(this%unit, FILE = this%fn, ACCESS = 'STREAM', IOSTAT = io, STATUS = 'OLD', FORM = 'UNFORMATTED')
    IF (io /= 0) STOP 'end of file emcountered'

    ASSOCIATE (riff => this%riff, fmt => this%riff%fmt, dat => this%riff%dat)
! RIFF-WAVE chunk
     READ(this%unit) riff
     IF (riff%chunk_id  /= 'RIFF') STOP 'this is not RIFF file'
     IF (riff%formattag /= 'WAVE') STOP 'this RIFF file is not in WAVE format'
! fmt chunk
     IF ( fmt%chunk_id  /= 'fmt '  ) STOP 'fmt chunk not found'
     IF ( fmt%format_id /=  1      ) STOP 'Unknown WAVE format' ! 1 Linear PCM
     IF ( fmt%bits_per_sample /= 16) STOP 'Not 16bit data'
     SELECT CASE ( fmt%channels )
      CASE (1)
         WRITE(*, '(a, i3, a, i6, a)') 'Monoral', fmt%bits_per_sample, 'bit Sampling rate', fmt%sampling_rate, 'Hz '
      CASE (2)
         WRITE(*, '(a, i3, a, i6, a)') 'Stereo' , fmt%bits_per_sample, 'bit Sampling rate', fmt%sampling_rate, 'Hz '
      CASE DEFAULT
         STOP 'Wave channels must be 1 or 2'
     END SELECT
! data chunk
     IF (dat%chunk_id /= 'data') THEN
       DO      
         INQUIRE(this%unit, POS = this%ipos)
         this%ipos = this%ipos + dat%chunk_size  ! skip non-data chunk
         READ(this%unit, POS = this%ipos, IOSTAT = io) dat
         IF (io == -1) STOP 'end of file encounterd while searching for a data chunk'
         IF (dat%chunk_id == 'data') EXIT
        END DO
     END IF
! now POS is at the beginning of PCM data 
    END ASSOCIATE

    RETURN
  END SUBROUTINE openfile
  !------------------------------------------------
  SUBROUTINE closefile(this)           
    CLASS(t_wavfile), INTENT(IN) :: this

    CLOSE(this%unit)

    RETURN
  END SUBROUTINE closefile
  !------------------------------------------------
  SUBROUTINE read_pcm(this, pcm)
    CLASS(t_wavfile), INTENT(IN) :: this
    REAL(kd), INTENT(OUT) :: pcm(0:, 0:)
    REAL(kd), PARAMETER :: denom = REAL(2**15, kd)
    INTEGER(2) :: buff16(SIZE(pcm))
     
    READ(this%unit) buff16
    SELECT CASE ( SIZE(pcm, 2) )
     CASE (1) !mono
       pcm(:, 0) = buff16 / denom        ! 
       pcm(:, 1) = 0.0d0
     CASE (2) !stereo
       pcm(:, 0) = buff16(1::2) / denom  ! Left  channel
       pcm(:, 1) = buff16(2::2) / denom  ! Right channel
     CASE DEFAULT
       STOP 'input file must be 1 or 2 channel(s)'
    END SELECT

    RETURN 
  END SUBROUTINE read_pcm

END MODULE m_wavio

!==============================================

PROGRAM test
  USE m_kind
  USE m_wavio
  IMPLICIT NONE
  TYPE (t_wavfile), ALLOCATABLE :: wavfile
  REAL(kd) :: buff(0:863, 0:1)
  INTEGER :: i, j
  buff = 0.0_kd
  
  ALLOCATE( wavfile )
  CALL wavfile%openfile('2000hz.wav')
  CALL wavfile%read_pcm(buff)
  DO j = 1, 3
   DO i = 0, UBOUND(buff, 1)
    PRINT *, i, buff(i, :)
   END DO
   buff = EOSHIFT(buff, 384)
   CALL wavfile%read_pcm(buff(480:, :))
  END DO
  CALL wavfile%closefile()
  DEALLOCATE( wavfile )
  
  STOP
END PROGRAM test