いちいち外部入力装置番号を覚えておかなくてはいけないとか、オプションも自由気ままなんて、あまりにカオスすぎる。
ということで、perlなどのようにファイルを開くことができるようなwrapperを作ってみた。これ以外で使う時は、scratchでファイルを作ってOut of Coreのプログラムを書く時くらいだろうか。バイナリなんかめったにいじらないし。
こんな感じで使える。
funit = open_file('>', "test.dat") !書き込み専用
funit = open_file('<', "test.dat") !読み込み専用
funit = open_file('>>', "test.dat") !追加書き込み専用
funit = open_file('+<', "test.dat") !読み書き可能
funit = open_file('+>', "test.dat") !読み書き可能(ファイル新規作成)
funit = open_file('+>>', "test.dat") !読み書き可能追加書き込み
本体のモジュールが次のような感じ。未使用の外部入力装置番号を検索してそれを自動で割り当てて、あとはただのwrapper。未使用の外部入力装置番号のインデックスは、モジュールのprivateメンバ変数にしてしまっても良いかもしれない。
module file
implicit none
! define error codes
integer, parameter :: ERR_FOPEN = -1
integer, parameter :: ERR_FMODE = -2
integer, parameter :: ERR_FUNIT = -8
contains
! ----------------------------------------
! open file like 'c' and 'perl'.
! if success, returns unit number.
! if error, returns minus number.
!
! write only:
! funit = open_file('>', file_name)
! funit = open_file('w', file_name)
! ----------------------------------------
integer function open_file(mode, file_name)
character(len=*), intent(in) :: mode
character(len=*), intent(in) :: file_name
integer :: ios
character(len=7) :: fstatus
character(len=9) :: faction
character(len=6) :: fpos
integer :: funit
funit = get_file_unit()
if ((mode == '<') .or. (mode == 'r')) then
! read only
fstatus='old'
faction='read'
fpos='rewind'
elseif ((mode == '>') .or. (mode == 'w')) then
! write only
fstatus='replace'
faction='write'
fpos='rewind'
elseif ((mode == '>>') .or. (mode == 'a')) then
! append only
fstatus='unknown'
faction='write'
fpos='append'
elseif ((mode == '+<') .or. (mode == 'r+')) then
fstatus='old'
faction='readwrite'
fpos='rewind'
elseif ((mode == '+>') .or. (mode == 'w+')) then
fstatus='replace'
faction='readwrite'
fpos='rewind'
elseif ((mode == '+>>') .or. (mode == 'a+')) then
fstatus='unknown'
faction='readwrite'
fpos='append'
else
! invalid mode
open_file = ERR_FMODE
return
endif
! file open
open(unit=funit, file=file_name, iostat=ios, status=fstatus, &
action=faction, position=fpos)
! check file open error
if (ios==0) then
open_file = funit
else
open_file = ERR_FOPEN
endif
return
end function open_file
! ----------------------------------------
! get file unit which has not opened.
! return minus if error found.
! ----------------------------------------
integer function get_file_unit()
integer :: i
integer, parameter :: MAX_UNIT = 999
logical :: fopened
do i = 100, MAX_UNIT
inquire(unit=i, opened=fopened)
if (fopened .neqv. .true.) then
get_file_unit = i
return
endif
enddo
! not found unopened file unit.
get_file_unit = ERR_FUNIT
return
end function get_file_unit
end module file
0 件のコメント:
コメントを投稿