2013年5月4日土曜日

fortranのファイルオープン関数

fortranのファイルオープンをしようとすると、いつも引数の指定方法を忘れてしまう。cとかperlみたいにopenするのに慣れすぎた。

いちいち外部入力装置番号を覚えておかなくてはいけないとか、オプションも自由気ままなんて、あまりにカオスすぎる。

ということで、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 件のコメント:

コメントを投稿