Fortran汎用コード - 超音波流体屋のプログラム備忘録

行番号カウント

コマンド wc -l の手実装版

integer function wc_fort(inpfile)
        implicit none
        character(*) :: inpfile
        integer :: stat, num_inp
 
        open(11, file=inpfile, status='old', iostat=stat)
        if(stat .ne. 0) then
            print *, 'Input file does not exist, exit...'
            stop
        end if
        num_inp = -1
        do while(stat .eq. 0)
            read(11, *, iostat=stat)
            num_inp = num_inp + 1
        end do
        close(11)
 
        wc_fort = num_inp
    end function wc_fort
 

ディレクトリ生成

多分もう少しきれいに書ける気がする

subroutine prep_dir(status, outdir)
    !use ifport  !intel fortranなら
    implicit none
 
    integer :: status
    character(*) :: outdir
    character(len=256) :: syscall
    character(len=16)  :: devnull = 'nul' !linuxなら /dev/nullにする
    !character(len=16) :: devnull = '/dev/null'
 
    character(len=64), parameter :: CMDPATH = ''
    !character(len=64), parameter :: CMDPATH = 'C:\MinGW\msys\1.0\bin\'
 
    write(syscall, '(a,a,a,a,a)'), 'ls ', trim(outdir), '>', devnull, ' 2>&1'
    status = system(trim(syscall))
 
    if (status .ne. 0 ) then
        write(syscall, '(a,a,a)'), trim(CMDPATH), 'mkdir ', trim(outdir)
        status = system(trim(syscall))
        if (status .ne. 0) then
            print *, 'Fail to create dir :', outdir
            status = -1
            return
        end if
    end if
 
    status = 1
end subroutine prep_dir
 

特定シンボルまでファイル読み飛ばし

integer function Skip_Line_Until(symbol, fi, line)
    character(*), intent(in) :: symbol
    integer, intent(in) :: fi
    character(*), intent(inout) :: line
 
    integer :: num_skiped, status
    logical :: wait_symbol
 
    status = 0; num_skiped = 0; wait_symbol = .true.
 
    do while( wait_symbol .and. (status .eq. 0) )
        read(fi, '(a)', iostat=status), line
        num_skiped = num_skiped + 1
        wait_symbol = (index(line, symbol) .eq. 0)
    end do
 
    if ( status .ne. 0 ) then
        Skip_Line_Until = -1
    else
        Skip_Line_Until = num_skiped
    end if
end function Skip_Line_Until