fortran コマンドライン引数処理

今日はfortranでコマンドライン引数を処理するサブルーチンを作ってみたので貼っておく。

fortranは言語仕様ではコマンドライン引数へのアクセスができないけども、通常のcompilerではiargc関数、getargサブルーチンが拡張仕様として備わっているので、最近では問題ないのかなと思う。

* Fortran 2003に対応しているcompilerならば、下記の関数を使う。
count = command_argument_count(), CALL get_command_argument(i, arg)

インターフェースはperlの標準モジュール"Getopt::Std"を真似した。使い方も大体同じ。
http://perldoc.perl.org/Getopt/Std.html

例えば、"-f"とか、"-i"とかよくやるやり方でfortranに引数を渡せるというまぁまぁ便利なものになった。

$ ./a.out -f filename -i
 f:filename
 i:1
 s:0

ソースは下記のようなもの。例えば下記のように"f:is"というオプションリストを渡すと、fについては文字列が格納され、i、sにはフラグ（0:off,1:on）がoptsという文字列配列に返される。順番は"f:is"で指定した順に入る。

program getarg
    implicit none

    character(len=256) :: opts(3)

    call getopt("f:is", opts)

    print *, "f:", trim(opts(1))
    print *, "i:", trim(opts(2))
    print *, "s:", trim(opts(3))

    stop
end program getarg

! --------------------------------------------------
subroutine getopt(optlist, opts)
! --------------------------------------------------
! parse command line arguments specified with
! single-character swiches.
!
! Usage: 
! call getopt("f:is", opts)
!
! where, switches followed by ":" takes arguments, 
! and others work as flag.
!
! for example, "./a.out -f file -i" returns
!  opts(1): file
!  opts(2): 1
!  opts(3): 0
! --------------------------------------------------

    type opt
        character(len=1)   :: name
        logical            :: arg  ! flag opt takes arg or not.
        character(len=256) :: val
    end type opt

    character(len=*), intent(in)  :: optlist
    character(len=*), intent(out) :: opts(:)

    integer                :: i, j, nopts
    character(len=256)     :: argv
    character(len=1)       :: optname
    type(opt), allocatable :: opts_tmp(:)

    allocate(opts_tmp( size(opts) ))

    ! parse optlist
    nopts = 0
    do i =1,len_trim(optlist)
        optname = optlist(i:i)
        if (optname /= ":") then
            nopts = nopts+1
            if (nopts > size(opts)) then
                print *, "error: number of options exceeds the size of opts"
            endif

            opts_tmp(nopts)%name = optname
            opts_tmp(nopts)%arg  = .false.
            opts_tmp(nopts)%val  = "0"
        endif

        if (optname == ":") opts_tmp(nopts)%arg = .true.
    enddo

    ! check command line arguments
    do i = 1, iargc()
        call getarg(i, argv)

        if (argv(1:1) == "-") then
            ! serach option list
            do j = 1,nopts
                if (opts_tmp(j)%name == argv(2:2)) then
                    ! found option, set value
                    if (opts_tmp(j)%arg .eqv. .true.) then
                        call getarg(i+1, opts_tmp(j)%val)
                    else
                        opts_tmp(j)%val = "1"
                    endif
                endif
            enddo
        endif
    enddo

    do i = 1, nopts
        opts(i) = opts_tmp(i)%val
    enddo

    deallocate(opts_tmp)

    return
end subroutine getopt