Fortran 2003 での BMP ファイルの読み書きルーチン

24bit BMP 形式のファイルを入出力します。画像の X 方向（横方向）サイズが 4 の倍数になっていない場合、各行ごとのデータのバイト数が 4 の倍数になるように、BMP ファイルの各行末を 0 でパディングしなければなりません。このバイト数は画像の X 方向サイズを 4 で割った余りになります。

parametrized derived type を用いると、動的に派生型内部の配列のサイズを変えられないので（多分）、ファイル読み込みの時に困難が生じます。ここでは allocatable 型を使うことにしました。
(間違っていたので追記：正確にはparametrized derived typeもallocatable 属性をつけて動的に確保できます。問題は OO の derived type とする場合、属性を allocatable や pointer 型に出来ないことでした。)

Fortran2003 の OO 機能を用いて、サブルーチンを派生型に従属させています。

実行結果

横方向サイズが 4 の倍数になっていない 24bit BMP ファイルを読み込み、左右反転して別の 24bit BMP ファイルとして出力します。

入力ファイル名: precure.bmp
出力ファイル名: reverse.bmp

入力画像　魔法つかいプリキュア！第１２話より

出力画像　（反転）

（なお Qiita では BMP ファイルをそのまま upload できません。）

ソースプログラム

あまりテストしてませんｗ

    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, g, r
      end type t_rgb 
      type :: t_bmp
        type (t_rgb), allocatable :: rgb(:, :)
      contains 
        procedure :: init => init_bmp
        procedure :: wr => wr_bmp
        procedure :: rd => rd_bmp
      end type  
    contains   
      subroutine init_bmp(bmp, nx, ny)
        class (t_bmp), intent(in out) :: bmp
        integer, intent(in) :: nx, ny
        allocate(bmp%rgb(nx, ny))
      end subroutine init_bmp
       
      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 => size(bmp%rgb, 1), ny => size(bmp%rgb, 2))
          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)
        class (t_bmp), intent(out) :: 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
        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
          allocate(bmp%rgb(nx, ny))
          read(10) (bmp%rgb(:, i), (dummy, j = 1, mod(nx, 4)), i = 1, ny)
          close(10)
        end associate  
      end subroutine rd_bmp
    end module m_bmp
    
    program bmp_RW
      use m_bmp
      implicit none
      type (t_bmp) :: pic0, pic1
      call pic0%rd('precure')
      allocate(pic1%rgb, mold = pic0%rgb)
      pic1%rgb = pic0%rgb(size(pic0%rgb, 1):1:-1, :) ! reverse
      call pic1%wr('reverse')
    end program bmp_RW