読者です 読者をやめる 読者になる 読者になる

Fortran で、form="unformatted", access="stream" で wirte されたファイルを read する

fortran programming

前置き

natures flyers: Fortran でのバイナリ (unformatted, binary) の扱いについてのメモ では write しか考えてなかった。なぜなら FIELDVIEW という可視化ソフトで読み込むことだけ考えてたので。でも今ちょっと、書きだしたデータを読み込んで処理したいなと思ってる。なので読み込み方を例によって trial & error で調べてみた。

Reference

参考にしたのはこのページくらい→ streamIO

バイナリエディタ

あと書きだしたファイルを見るにはバイナリエディタというのが必要なんだけど、僕が使ってる Notepad++ というエディタの場合、プラグインで HEX-Editor というのをインストールして、ファイルを選択した状態でメニューバーの Plugins > HEX-Editor > View in HEX で見れた。

open

ファイルの open 自体はそんな難しくない。こんな感じ。

  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "read" &
      & , form     = "unformatted" &
      & , access   = "stream" &
      & , status   = "old" &
      & , position = "rewind" &
  & )

ちゃんと動くコードはこのエントリ後半に掲載した。

read

これがちょっと面倒。read( ファイル名, pos=現在位置 ) のようにする必要がある。ポイントは「ファイル内での現在位置」を常に把握しておく、ということ。

そのために、loc という変数を用意してみた。これをまず 0 で初期化する。で、ファイルの先頭から読みとりを始めるわけだけど、pos は1から始まる正の整数。そこで、常に pos=loc+1 として、読み取った直後にいま読んだ変数の長さ分 loc にたしてやることにする。

とりあえず int, real(4), real(8) の3パタンだけ短いサブルーチンを作って、モジュールにまとめてみた。

読み取りモジュール

module mod__scan_str
  implicit none
  private
  
  public :: scan_int_str
  public :: scan_real_str
  public :: scan_dble_str
  
  integer, parameter :: len_int  = 4
  integer, parameter :: len_real = 4
  integer, parameter :: len_dble = 8
  
contains


subroutine scan_int_str( &
      &   n_file_in &
      & , loc &
      & , scanned_int &
  & )
  implicit none
  integer, intent(in) :: n_file_in
  integer, intent(inout) :: loc
  integer, intent(out) :: scanned_int
  !!------------------------------
  
  read(n_file_in, pos=loc+1) scanned_int
  loc = loc +len_int
  
  return
endsubroutine scan_int_str


subroutine scan_real_str( &
      &   n_file_in &
      & , loc &
      & , scanned_real &
  & )
  implicit none
  integer, intent(in) :: n_file_in
  integer, intent(inout) :: loc
  real(4), intent(out) :: scanned_real
  !!------------------------------
  
  read(n_file_in, pos=loc+1) scanned_real
  loc = loc +len_real
  
  return
endsubroutine scan_real_str


subroutine scan_dble_str( &
      &   n_file_in &
      & , loc &
      & , scanned_dble &
  & )
  implicit none
  integer, intent(in) :: n_file_in
  integer, intent(inout) :: loc
  real(8), intent(out) :: scanned_dble
  !!------------------------------
  
  read(n_file_in, pos=loc+1) scanned_dble
  loc = loc +len_dble
  
  return
endsubroutine scan_dble_str


endmodule mod__scan_str

注意事項

正直、自分は kind 関係のことはよくわかってない。なので len_int とかのとこはたぶん本当は selected_int_kind とかなんとかやるべきなんだろうけど(環境依存性に対処するために?)、 4 とかベタ書きしちゃってる。

テストコード

上のモジュールをテストするためのコード。

include 'mod__open_to_read.f90'
include 'mod__open_to_write.f90'
include 'mod__scan_str.f90'

module mod__sub
  use mod__open_to_read, only : open_to_read_unform_str
  use mod__open_to_write, only : open_to_write_unform_str_rewind
  use mod__scan_str
  implicit none
  private
  
  public :: main_part
contains


subroutine main_part
  implicit none
  integer, parameter :: n_int  = 1 !! テスト用変数の数。任意。以下同様
  integer, parameter :: n_real = 2
  integer, parameter :: n_dble = 3
  integer :: arr_int( n_int)
  real(4) :: arr_real(n_real)
  real(8) :: arr_dble(n_dble)
  
  !! temporary
  integer :: i
  
  !! 現在位置
  integer, save :: loc
  
  !! file numbers & names
  integer, save :: n_file_out
  integer, save :: n_file_in
  character(len=72), save :: file_out
  character(len=72), save :: file_in
  
  !! 結果の表示
  integer :: scanned_int
  real(4) :: scanned_real
  real(8) :: scanned_dble
  !!-------------------
  
  !! set numbers
  do i=1,n_int
    arr_int(i) = i
  enddo
  
  do i=1,n_real
    arr_real(i) = real(i,4)
  enddo
  
  do i=1,n_dble
    arr_dble(i) = dble(i)
  enddo
  
  
  !! unformatted, stream で書き出し
  n_file_out = 30
  file_out = 'unformatted_stream.dat'
  call open_to_write_unform_str_rewind( n_file_out, file_out )
    write(n_file_out) (arr_dble(i)*1, i=1,n_dble)
    write(n_file_out) (arr_real(i)*1, i=1,n_real)
    write(n_file_out) (arr_int(i) *1, i=1,n_int )
  close(n_file_out)
  
  
  
  !! 上で書き出したものを読み込んで表示し、確認する
  n_file_in = 40
  file_in = file_out
  call open_to_read_unform_str( n_file_in, file_in )
    
    !! save 属性指定するだけで 0 に初期化されるが、念の為に再度初期化しておく。
    loc = 0
    
    !! 以下の読み込み順は write した時に合わせないともちろんダメ
    
    !! double
    do i=1,n_dble
      call scan_dble_str(n_file_in,loc,scanned_dble) !! intent(in,inout,out)
      write(*,*) scanned_dble
    enddo
    
    !! real
    do i=1,n_real
      call scan_real_str(n_file_in,loc,scanned_real) !! intent(in,inout,out)
      write(*,*) scanned_real
    enddo
    
    !! integer
    do i=1,n_int
      call scan_int_str(n_file_in,loc,scanned_int) !! intent(in,inout,out)
      write(*,*) scanned_int
    enddo
    
  close(n_file_in)
  
  return
endsubroutine main_part


endmodule mod__sub


program test_unform_str
  use mod__sub, only : main_part
  implicit none
  
  call main_part
  
  stop
endprogram test_unform_str

ただしここで、以下のファイルオープンモジュール(read用、write用)を使っている。

read用

module mod__open_to_read
  implicit none
  private
  
  public :: open_to_read__run
  public :: open_to_read_unform_seq
  public :: open_to_read_unform_str
  
contains

subroutine open_to_read__run( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber            !! filenumber to assign
  character(len=72), intent(in) :: filename_in !! filename as variable (not the actual text file name)
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  
  !! file open, w/ error handling
  ! open(filenumber,file=filename_in,status="old",iostat=istat,form="formatted",position="rewind",action="read")
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "read" &
      & , status   = "old" &
      & , position = "rewind" &
      & , form     = "formatted" &
      ! & , access   = "sequential" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a48,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_read__run


subroutine open_to_read_unform_seq( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber        !! filenumber to assign
  character(72), intent(in) :: filename_in !! filename as variable (not the actual text file name)
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  
  !! file open, w/ error handling
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "read" &
      & , status   = "old" &
      & , position = "rewind" &
      & , form     = "unformatted" &
      & , access   = "sequential" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a48,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_read_unform_seq


subroutine open_to_read_unform_str( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber        !! filenumber to assign
  character(72), intent(in) :: filename_in !! filename as variable (not the actual text file name)
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  
  !! file open, w/ error handling
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "read" &
      & , form     = "unformatted" &
      & , access   = "stream" &
      & , status   = "old" &
      & , position = "rewind" &
  & )

  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a48,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_read_unform_str


endmodule mod__open_to_read

write用

module mod__open_to_write
  implicit none
  private
  
  public :: open_to_write_form_rewind       !! formatted, rewind
  public :: open_to_write_form_append       !! formatted, append
  public :: open_to_write_unform_seq_rewind !! unformatted, sequential, rewind
  public :: open_to_write_unform_seq_append !! unformatted, sequential, append
  public :: open_to_write_unform_str_rewind !! unformatted, stream,     rewind
  
contains


subroutine open_to_write_form_rewind( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber
  character(len=72), intent(in) :: filename_in
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "write" &
      & , form     = "formatted" &
      & , status   = "replace" &
      & , position = "rewind" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a36,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_write_form_rewind


subroutine open_to_write_form_append( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber
  character(len=72), intent(in) :: filename_in
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "write" &
      & , form     = "formatted" &
      & , status   = "old" &
      & , position = "append" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a36,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_write_form_append


subroutine open_to_write_unform_seq_rewind( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber
  character(len=72), intent(in) :: filename_in
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "write" &
      & , form     = "unformatted" &
      & , access   = "sequential" &
      & , status   = "replace" &
      & , position = "rewind" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a36,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_write_unform_seq_rewind


subroutine open_to_write_unform_seq_append( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber
  character(len=72), intent(in) :: filename_in
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "write" &
      & , form     = "unformatted" &
      & , access   = "sequential" &
      & , status   = "old" &
      & , position = "append" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a36,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_write_unform_seq_append


subroutine open_to_write_unform_str_rewind( filenumber, filename_in )
  implicit none
  integer, intent(in) :: filenumber
  character(72), intent(in) :: filename_in
  integer :: istat=0
  !!---------------------
  
  write(*,"(2x,'opening [ ',a48,' ]... ',$)") filename_in
  open( &
      &   unit     = filenumber &
      & , file     = filename_in &
      & , iostat   = istat &
      & , action   = "write" &
      & , form     = "unformatted" &
      & , access   = "stream" &
      & , status   = "replace" &
      & , position = "rewind" &
  & )
  
  if( istat == 0 ) then
    write(*,"('... [ ',a48,' ] was successfully opened.')") filename_in
    return
  else
    write(*,"(/,2x,'Error: The file  [ ',a36,' ] ',/,' does not exist (istat =',i2,'). Aborting...',/)") filename_in, istat
    stop
  endif
  
  return
endsubroutine open_to_write_unform_str_rewind


endmodule mod__open_to_write

汚いけど、とりあえず公開。あ、こういうのこそ github 使うべきなのか…(いまさら)

実行結果

こんな感じになるはず

$ ./a.exe
  opening [ unformatted_stream.dat                           ]... ... [ unformatted_stream.dat                           ] was successfully opened.
  opening [ unformatted_stream.dat                           ]... ... [ unformatted_stream.dat                           ] was successfully opened.
   1.0000000000000000
   2.0000000000000000
   3.0000000000000000
   1.00000000
   2.00000000
           1