BMP ファイル I/O その２

#Parameterized Derived Type を利用した BMP I/O
[前回](http://qiita.com/cure_honey/items/1a501f4a72b113a9bc07) の発展として、24bit BMP ファイルの I/O を行うルーチンを Parameterized Derived Type を利用する形に書き直しました。

やってみると、色々些細なことで躓きましたが、PGI のサイトにある記事 [Object-Oriented Programming in Fortran 2003 Part 3: Parameterized Derived Types](https://www.pgroup.com/lit/articles/insider/v5n2a4.htm) が参考となりました。

Parameterized Derived Type で len 属性で配列を確保するような場合、自分で代入用の関数とインターフェース、コンストラクタ用のサブルーチンとインターフェースを用意しておかなければいけないようです。これは、allocatable 属性の配列を持つ派生型は、標準の代入文では自動 allocate が出来ないことと同じようなものだと思われます。

インターフェースを用意しておかないと、基本的に代入の代わりに allocate(a, source = b) の形を用いることになります。また、その他こまごまとした書き方の違いで、実行時エラーでの頓死など、仕様なのかコンパイラのバグなのかよく分からない動作を経験しました。まだ完全には理解していません。

##実行例　
ここでは BMP ファイルを読み込んで、画像を上下反転しています。コンパイラは、現在ベータテスト中の Intel Visual Fortran v.17.0 を用いています。
```
 BMP size: 326 x 404
続行するには何かキーを押してください . . .
```
![mirai.png](https://qiita-image-store.s3.amazonaws.com/0/44522/97b37f63-6d79-3f98-cba3-1d3993cfbf9c.png)

![reverse.png](https://qiita-image-store.s3.amazonaws.com/0/44522/f294900b-b2c2-458c-a038-3ac2a0f55c38.png)
（魔法つかいプリキュア！より）
##プログラム
BMP ファイルの読み込みは、OO 式に出来ないので普通のサブルーチン形式で読み込んでいます。（代入の形で、BMP 派生型の割り付けとファイル読み込みを同時にやることもできたのですが、その場合 module 側ではなく、メインプログラム側の内部関数として関数を用意してやらねばならなりませんでした。派生型の内部の配列の割り付けの問題なのですが、今のところ、この理由がよく分かりません。）

```fortran
    module m_bmp
      implicit none
      type :: t_bmp_file_header
        sequence  
        integer(2) :: bfType = transfer('BM', 0_2, 1) ! BitMap
        integer(4) :: bfSize          ! file size in bytes
        integer(2) :: bfReserved1 = 0 ! always 0
        integer(2) :: bfReserved2 = 0 ! always 0
        integer(4) :: bfOffBits
      end type t_bmp_file_header
      !
      type :: t_bmp_info_header
        sequence
        integer(4) :: biSize          = Z'28' ! size of bmp_info_header ; 40bytes 
        integer(4) :: biWidth
        integer(4) :: biHeight
        integer(2) :: biPlanes        = 1 ! always 1
        integer(2) :: biBitCount
        integer(4) :: biCompression   = 0 !0:nocompression,1:8bitRLE,2:4bitRLE,3:bitfield
        integer(4) :: biSizeImage
        integer(4) :: biXPelsPerMeter = 3780 ! 96dpi
        integer(4) :: biYPelsPerMeter = 3780 ! 96dpi 
        integer(4) :: biClrUsed       = 0
        integer(4) :: biClrImportant  = 0 
      end type t_bmp_info_header
      !
      type :: t_rgb
        sequence
        character :: b = 0, g = 0, r = 0
      end type t_rgb 
      
      type :: t_bmp(nx, ny)
        integer, len :: nx = 0, ny = 0  
        type (t_rgb) :: rgb(nx, ny) 
      contains 
        procedure :: wr => wr_bmp
      end type  
      !
      interface assignment(=)
        module procedure :: assign_bmp
      end interface assignment(=) 
      
      interface t_bmp
        module procedure :: construct_bmp
      end interface t_bmp
    contains   
      subroutine wr_bmp(bmp, fn)
        class (t_bmp(*, *)), intent(in) :: bmp
        character (len = *), intent(in) :: fn
        type (t_bmp_file_header) :: bmp_file_header
        type (t_bmp_info_header) :: bmp_info_header
        integer :: i, j
        associate(nx => bmp%nx, ny => bmp%ny)
          bmp_file_header%bfSize      = 14 + 40 + 0 + (3 * nx + mod(nx, 4)) * ny
          bmp_file_header%bfOffBits   = 14 + 40
          bmp_info_header%biWidth     = nx
          bmp_info_header%biHeight    = ny
          bmp_info_header%biBitCount  = 24 
          bmp_info_header%biSizeImage = (3 * nx + mod(nx, 4)) * ny
          open(9, file = fn//'.bmp', access = 'stream', status = 'unknown')
          write(9) bmp_file_header
          write(9) bmp_info_header
          write(9) (bmp%rgb(:, i), (achar(0), j = 1, mod(nx, 4)), i = 1, ny)
          close(9)
        end associate
      end subroutine wr_bmp
      
      subroutine rd_bmp(bmp, fn)
        character (len = *), intent(in) :: fn
        type (t_bmp(:, :)) , intent(out), allocatable :: bmp
        type (t_bmp_file_header) :: bmp_file_header
        type (t_bmp_info_header) :: bmp_info_header
        integer :: i, j
        character :: dummy
        associate(nx => bmp_info_header%biWidth, ny => bmp_info_header%biHeight)
          open(10, file = fn//'.bmp', access = 'stream', status = 'old')
          read(10) bmp_file_header
          read(10) bmp_info_header
          bmp = t_bmp(nx, ny)
          read(10) (bmp%rgb(:, i), (dummy, j = 1, mod(nx, 4)), i = 1, ny)
          close(10)
        end associate
      end subroutine rd_bmp
      
      function construct_bmp(nx, ny) result(res)
        integer, intent(in) :: nx, ny
        type (t_bmp(:, :)), allocatable :: res
        allocate(t_bmp(nx, ny)::res)
      end function construct_bmp    

      function read_bmp(fn) result(res)
        character (len = *), intent(in) :: fn
        type (t_bmp(:, :)), allocatable :: res
        call rd_bmp(res, fn)
      end function read_bmp    

      subroutine assign_bmp(dest, src) 
        type (t_bmp(:, :)), intent(out), allocatable :: dest
        type (t_bmp(*, *)), intent(in ) :: src
        allocate(dest, source = src)
      end subroutine assign_bmp    
    end module m_bmp
    
    program bmp_RW
      use m_bmp
      implicit none
      type (t_bmp(:, :)), allocatable :: pic0, pic1
      call rd_bmp(pic0, 'mirai')
      print *, 'BMP size:', pic0%nx, 'x', pic0%ny
      pic1 = pic0                          ! allocate(pic1, source = pic0)
      pic1%rgb = pic0%rgb(:, pic0%ny:1:-1) ! reverse
      call pic1%wr('reverse')      
      deallocate(pic0, pic1)
    end program bmp_RW
```