Fortranの数値計算でインプットファイルをファイルから読み込む ver2

"Fortranの数値計算でインプットファイルをファイルから読み込む"
https://qiita.com/cometscome_phys/items/c7a773ea228b4e54df58
の改良版です。

Fortran2003以降では、コマンドラインの引数を使ってファイルの読み込みが簡単にできます。
Fortranで数値計算をする際に、必要なインプットをファイルから与える、ことができるようになります。

今回は前回のように読み込みたいパラメータごとに細かなIf文を設定するのをやめました。
任意のキーワードで読み込めるように、簡単にできるようにしました。
特に、あらかじめ初期値を定めていて、ファイルの中に同じものがある場合にのみ初期値から読み込んだ値を使うようにしています。これによって、読み込むファイルに全てのパラメータを書かなくても良くなりました。

この記事の最後にオブジェクト指向を使ったスッキリ書く方法も載せておきます。

#バージョン
gcc version 9.1.0 (Homebrew GCC 9.1.0)

#読み込むファイル
今回も、インプットファイルの中で「=」を含む行の左がキーワード、右側が値、というインプットフォーマット

stan.in

Lx = 12
Ly = 16
U = 3d0

をFortranで読み込んでみます。

#コマンドラインの引数を読み込む
ここは以前と同じです。

それを実現するmoduleは

module readfiles
    implicit none

    interface readarg
        module procedure readarg_1
        module procedure readarg_2
    end interface readarg

    contains 

    subroutine readarg_1(arg1)
        implicit none
        integer::i,length,status
        character(:), allocatable,intent(out) :: arg1
        intrinsic :: command_argument_count, get_command_argument
        if (command_argument_count() .ne. 1) then
            write(*,*) "error! num. of arguments should be 1"
            stop
        end if
        i = 1
        call get_command_argument(i, length = length, status = status)
        if (status == 0) then
            allocate (character(length) :: arg1)
            call get_command_argument(i, arg1, status = status)
            write(*,*) arg1
        end if

    end subroutine

    subroutine readarg_2(arg1,arg2)
        implicit none
        integer::i,length,status
        character(:), allocatable,intent(out) :: arg1,arg2
        intrinsic :: command_argument_count, get_command_argument
        if (command_argument_count() .ne. 2) then
            write(*,*) "error! num. of arguments should be 1"
            stop
        end if
        i = 1
        call get_command_argument(i, length = length, status = status)
        if (status == 0) then
            allocate (character(length) :: arg1)
            call get_command_argument(i, arg1, status = status)
            write(*,*) arg1
        end if

        i = 2
        call get_command_argument(i, length = length, status = status)
        if (status == 0) then
            allocate (character(length) :: arg2)
            call get_command_argument(i, arg2, status = status)
            write(*,*) arg2
        end if        

    end subroutine    


end module readfiles

となります。

#インプットファイルを読み込む
上のmoduleに、さらにインプットファイルを読み込むサブルーチンを追加します。
その際、キーワードを自分で指定できるようにしました。
メインのプログラムでは、

program main
    use readfiles
    implicit none

    character(:), allocatable::arg1
    integer::Lx,Ly
    real(8)::U
    Lx = 1
    Ly = 1
    U = 1d0

    call readarg(arg1)
    call readfromfiles(arg1,"Lx",Lx)
    call readfromfiles(arg1,"Ly",Ly)
    call readfromfiles(arg1,"U",U)
    write(*,*) Lx,Ly,U
    return
end program main

こんな感じでモジュールを呼びます。
あれば値を上書きし、なければデフォルト値のまま、という動作です。

これを実現するコードは、

module readfiles
    implicit none

    interface readarg
        module procedure readarg_1
        module procedure readarg_2
    end interface readarg

    interface readfromfiles
        module procedure readfromfiles_dble
        module procedure readfromfiles_int
    end interface readfromfiles

    contains 

    subroutine readarg_1(arg1)
        implicit none
        integer::i,length,status
        character(:), allocatable,intent(out) :: arg1
        intrinsic :: command_argument_count, get_command_argument
        if (command_argument_count() .ne. 1) then
            write(*,*) "error! num. of arguments should be 1"
            stop
        end if
        i = 1
        call get_command_argument(i, length = length, status = status)
        if (status == 0) then
            allocate (character(length) :: arg1)
            call get_command_argument(i, arg1, status = status)
            write(*,*) arg1
        end if

    end subroutine

    subroutine readarg_2(arg1,arg2)
        implicit none
        integer::i,length,status
        character(:), allocatable,intent(out) :: arg1,arg2
        intrinsic :: command_argument_count, get_command_argument
        if (command_argument_count() .ne. 2) then
            write(*,*) "error! num. of arguments should be 1"
            stop
        end if
        i = 1
        call get_command_argument(i, length = length, status = status)
        if (status == 0) then
            allocate (character(length) :: arg1)
            call get_command_argument(i, arg1, status = status)
            write(*,*) arg1
        end if

        i = 2
        call get_command_argument(i, length = length, status = status)
        if (status == 0) then
            allocate (character(length) :: arg2)
            call get_command_argument(i, arg2, status = status)
            write(*,*) arg2
        end if        

    end subroutine    

    subroutine readfromfiles_dble(filename,key,dvalue)
        implicit none
        character(len=*),intent(in)::filename
        character(len=*),intent(in)::key
        real(8),intent(inout)::dvalue

        integer::io
        integer,parameter :: max_line_len = 4000
        character(max_line_len) linebuf
        integer::equalposition
        integer::length
        character(:), allocatable::cvalue,ckeyword

        open(101,file=filename)
        
        do 
            read(101,'(a)',iostat = io) linebuf
            if (io < 0) exit
            !write(*,*) "Original string: ",trim(linebuf)
            equalposition = index(trim(linebuf),"=")
            if (equalposition.ne. 0) then
                length = len(trim(linebuf(:equalposition-1)))
                allocate(character(length) :: ckeyword)
                length = len(trim(linebuf(equalposition+1:)))
                allocate(character(length) :: cvalue)
                if (ckeyword == key) then
                    read(cvalue,*) dvalue
                    !write(*,*) ckeyword, dvalue
                end if 
                deallocate(cvalue)
                deallocate(ckeyword)
            end if
        end do
        close(101)

        return
    end subroutine    


    subroutine readfromfiles_int(filename,key,ivalue)
        implicit none
        character(len=*),intent(in)::filename
        character(len=*),intent(in)::key
        integer,intent(inout)::ivalue

        integer::io
        integer,parameter :: max_line_len = 4000
        character(max_line_len) linebuf
        integer::equalposition
        integer::length
        character(:), allocatable::cvalue,ckeyword

        open(101,file=filename)
        
        do 
            read(101,'(a)',iostat = io) linebuf
            if (io < 0) exit
            !write(*,*) "Original string: ",trim(linebuf)
            equalposition = index(trim(linebuf),"=")
            if (equalposition.ne. 0) then
                length = len(trim(linebuf(:equalposition-1)))
                allocate(character(length) :: ckeyword)
                length = len(trim(linebuf(equalposition+1:)))
                allocate(character(length) :: cvalue)
                if (ckeyword == key) then
                    read(cvalue,*) ivalue
                    !write(*,*) ckeyword, ivalue
                end if 
                deallocate(cvalue)
                deallocate(ckeyword)
            end if
        end do
        close(101)

        return
    end subroutine      



end module readfiles

となります。

./a.out test.in

を実行すると、

 test.in
          12          16   3.0000000000000000  

と出力されます。

オブジェクト指向を用いた書き方

オブジェクト指向を使ったコードを載せます。

mainのコードはここまでシンプルになります。

program main
    use system
    implicit none
    type(systemparam)::param

    param = init_systemparam()
    call param%print()
    return
end program main

以下はsystemモジュールの具体的な中身です。
readfilesモジュールも使っていますが、中身は同じです。
ここではsystemモジュールを作り、typeとしてsystemparamを用意します。
この中に初期値の情報を入れておきます。

module system
    use readfiles
    implicit none

    type systemparam
        integer::Lx,Ly
        real(8)::U
        contains
        procedure::print => print_systemparam

    end type systemparam

    interface systemparam
        module procedure init_systemparam
    end interface systemparam

    contains 

    subroutine print_systemparam(self)
        implicit none
        class(systemparam)::self
        write(*,*) "Lx   ","Ly     ","U     "
        write(*,*) self%Lx,self%Ly,self%U
    end subroutine


    type(systemparam) function init_systemparam() result(x)
        implicit none
        character(:), allocatable::arg1
        integer::Lx,Ly
        real(8)::U
        Lx = 1
        Ly = 1
        U = 1d0
        call readarg(arg1)
        call readfromfiles(arg1,"Lx",Lx)
        call readfromfiles(arg1,"Ly",Ly)
        call readfromfiles(arg1,"U",U)
        x%Lx = Lx
        x%Ly = Ly
        x%U = U
        deallocate(arg1)
        return
    end function

end module system