dc_iounit.f90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Youhei SASAKI, Yasuhiro MORIKAWA
!> @copyright Copyright (C) GFD Dennou Club, 2007-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!> @en
!> @brief Unit number handling at file open
!> @details
!> Unit number is handled when a file is opened.
!> Subroutine "FileOpen" receives filename and open mode firstly, and
!> searches an available unit number internally, and
!> opens the file according to the open mode internally, and
!> returns the unit number finally.
!> This module simplifies source codes for unit number management or
!> readable/writable check.
!>
!> @section iounit_procedures Procedures List
!>
!> | Procedure  | Description                                            |
!> |------------|--------------------------------------------------------|
!> | FileOpen   | A file is opened and unit number is returned with a filename and mode |
!>
!> @section iounit_usage Usage
!>
!> Give filename and open mode to subroutine "FileOpen" provided by
!> this module.  Then the file is opened and unit number is returned
!> to an argument `unit`.  Using the unit number, read the contents
!> of the file or write in the file.  Use Fortran built-in READ,
!> WRITE, and CLOSE statements for read/write and close.
!>
!> @section iounit_example Example
!>
!> @code{.f90}
!> program dc_iounit_sample
!>   use dc_types, only: TOKEN
!>   use dc_iounit, only: FileOpen
!>   implicit none
!>   integer:: unit00, unit01
!>   character(TOKEN):: char
!>   character(TOKEN):: filename = 'dc_iounit_sample.nml'
!>   integer:: int
!>   namelist /dc_iounit_sample_nml/ char, int
!> continue
!>
!>   call FileOpen(unit00, file = filename, mode = 'w')
!>   write(unit00, *) '&dc_iounit_sample_nml'
!>   write(unit00, *) '  char = "hogehoge",'
!>   write(unit00, *) '  int = 123'
!>   write(unit00, *) '/'
!>   close(unit00)
!>
!>   call FileOpen(unit01, file = filename, mode = 'r')
!>   read(unit01, nml = dc_iounit_sample_nml)
!>   close(unit01)
!>   write(0, nml = dc_iounit_sample_nml)
!>
!> end program dc_iounit_sample
!> @endcode
!>
!> @enden
!>
!> @ja
!> @brief ファイルオープン時の装置番号処理
!> @details
!> ファイルをオープンする際に使用する装置番号の処理を行います.
!> サブルーチン FileOpen にファイル名とオープン時のモードを与えることで,
!> 利用可能な装置番号を内部で探査し,
!> 内部でファイルをモードに合わせてオープンしてから, 装置番号を返します.
!> このモジュールは, 装置番号の管理やファイルの読み取り/書き込み可能
!> などの確認作業のためのソースコードを簡素化します.
!>
!> @section iounit_procedures_ja 手続一覧
!>
!> | 手続名     | 説明                                                   |
!> |------------|--------------------------------------------------------|
!> | FileOpen   | ファイル名とモードを与えることでファイルをオープンし, 装置番号を返します |
!>
!> @section iounit_usage_ja 使用方法
!>
!> このモジュールで提供されるサブルーチン FileOpen に
!> ファイル名とオープン時のモードを与えてください.
!> するとファイルがオープンされ, 引数 `unit` に装置番号が返ります.
!> その装置番号を用い, ファイルの内容の読み込みや
!> ファイルへの書き込みを行ってください. 読み込みや書き込みやクローズには
!> Fortran 組み込みの READ 文や WRITE 文, CLOSE 文を用いてください.
!>
!> @section iounit_example_ja 使用例
!>
!> @code{.f90}
!> program dc_iounit_sample
!>   use dc_types, only: TOKEN
!>   use dc_iounit, only: FileOpen
!>   implicit none
!>   integer:: unit00, unit01
!>   character(TOKEN):: char
!>   character(TOKEN):: filename = 'dc_iounit_sample.nml'
!>   integer:: int
!>   namelist /dc_iounit_sample_nml/ char, int
!> continue
!>
!>   call FileOpen(unit00, file = filename, mode = 'w')
!>   write(unit00, *) '&dc_iounit_sample_nml'
!>   write(unit00, *) '  char = "hogehoge",'
!>   write(unit00, *) '  int = 123'
!>   write(unit00, *) '/'
!>   close(unit00)
!>
!>   call FileOpen(unit01, file = filename, mode = 'r')
!>   read(unit01, nml = dc_iounit_sample_nml)
!>   close(unit01)
!>   write(0, nml = dc_iounit_sample_nml)
!>
!> end program dc_iounit_sample
!> @endcode
!>
!> @endja
!>
 
module dc_iounit
  implicit none
  private
 
  public:: fileopen
 
  character(*), parameter:: version = &
    & '$Name:  $' // &
    & '$Id: dc_iounit.f90,v 1.1 2009-03-20 09:09:53 morikawa Exp $'
 
  interface fileopen
    module procedure fileopen
  end interface
 
contains
 
  !> @en
  !> @brief Open a file and return unit number
  !> @details
  !> Filename is given to `file`, and open mode is given to `mode`,
  !> then the file is opened and unit number is returned.
  !>
  !> | Mode | Description                                                     |
  !> |------|-----------------------------------------------------------------|
  !> | "r"  | A file is opened with read-only mode                            |
  !> | "w"  | A file is opened with writable mode. If a file is exist already, the content of the file is emptied. |
  !> | "a"  | A file is opened with writable mode. Output is appended at the end of the file. |
  !> | "rw" | A file is opened with read/write mode. If a file is exist already, the content of the file is emptied. |
  !> | "ra" | A file is opened with read/write mode. If a file is exist already, a position of read/write is set at the end of the file. |
  !>
  !> If the file can not be opened with the mode, the program aborts.
  !> If this `err` argument is given, `.true.` is substituted to `err` and
  !> -1 is substituted to `unit` and the program does not abort.
  !>
  !> @param[out] unit Unit number assigned to the opened file
  !> @param[in] file Filename to open
  !> @param[in] mode Open mode ("r", "w", "a", "rw", "ra"). Default is "r".
  !> @param[out] err Exception handling flag
  !> @enden
  !>
  !> @ja
  !> @brief ファイルをオープンし、装置番号を返します
  !> @details
  !> ファイル名を `file` へ, オープンする際のモードを `mode` へと
  !> 与えることで, ファイルをオープンし, 装置番号を `unit` に返します.
  !> `mode` には以下の文字列を指定します. 省略時は "r" が指定されたもの
  !> とみなします.
  !>
  !> | モード | 説明                                                           |
  !> |--------|----------------------------------------------------------------|
  !> | "r"    | ファイルを読み込みモードでオープンします.                      |
  !> | "w"    | ファイルを書き込みモードでオープンします. オープン時にファイルがすでに存在していればその内容を空にします. |
  !> | "a"    | ファイルを書き込みモードでオープンします. 出力はファイルの末尾に追加されます. |
  !> | "rw"   | ファイルを読み書き両用モードでオープンします. オープン時にファイルがすでに存在していればその内容を空にします. |
  !> | "ra"   | ファイルを読み書き両用モードでオープンします. オープン時にファイルがすでに存在していれば読み書き位置がファイルの末尾にセットされます. |
  !>
  !> ファイルが `mode` で指定されるモードで開けない場合, プログラムは
  !> 強制終了します. 引数 `err` が与えられる場合, プログラムは強制終了せず,
  !> 代わりに `err` に `.true.` が, `unit` に -1 が代入されます.
  !>
  !> @param[out] unit オープンされたファイルに割り当てられた装置番号
  !> @param[in] file オープンするファイル名
  !> @param[in] mode オープンモード ("r", "w", "a", "rw", "ra"). デフォルトは "r".
  !> @param[out] err 例外処理用フラグ
  !> @endja
  subroutine fileopen( &
    & unit, file, mode, &
    & err )
    use dc_types, only: string, token
    use dc_trace, only: beginsub, endsub
    use dc_error, only: storeerror, dc_noerr, &
      & dc_efilenameempty, dc_ebadfileopmode, dc_enounitnum, &
      & dc_enofileexist, dc_enofileread, dc_enofilewrite
    use dc_present, only: present_and_not_empty
    use dc_string, only: tochar, tolower
    implicit none
    integer, intent(out):: unit
    character(*), intent(in):: file
    character(*), intent(in), optional:: mode
    logical, intent(out), optional:: err
 
    !-----------------------------------
    !  作業変数
    !  Work variables
    integer, parameter:: max_unit = 99
                              ! NAMELIST ファイルをオープンするための
                              ! 装置番号の最大値. Fortran で使用可能な
                              ! 範囲 (0〜99) のうち, 
                              ! 最大値が設定されている.
                              ! 
                              ! Maximum unit number for open of
                              ! NAMELIST file. An maximum
                              ! value within the bounds of available number
                              ! in Fortran (0 - 99) is specified.
    integer, parameter:: min_unit = 0
                              ! NAMELIST ファイルをオープンするための
                              ! 装置番号の最小値. Fortran で使用可能な
                              ! 範囲 (0〜99) のうち, 
                              ! 最小値が設定されている.
                              ! 
                              ! Minimum unit number for open of
                              ! NAMELIST file. An minimum
                              ! value within the bounds of available number
                              ! in Fortran (0 - 99) is specified.
    character(TOKEN):: open_mode
    integer:: unit_work
    logical:: unit_exist_flag, unit_opend_flag
    logical:: file_exist_flag
    integer:: iostat
    integer:: stat
    character(STRING):: cause_c
    character(*), parameter:: subname = 'FileOpen'
  continue
    call beginsub(subname, version)
    stat = dc_noerr
    cause_c = ''
    unit = -1
 
    !-----------------------------------------------------------------
    !  オプショナル引数のチェック
    !  Check optional arguments
    !-----------------------------------------------------------------
    if (present_and_not_empty(mode)) then
      open_mode = mode
    else
      open_mode = 'r'
    end if
    call tolower(open_mode)
 
    !-----------------------------------------------------------------
    !  引数の正当性のチェック
    !  Validation of arguments
    !-----------------------------------------------------------------
    if ( trim(file) == '' ) then
      stat = dc_efilenameempty
      goto 999
    end if
 
    !----------------------------------------------------------------
    !  使用可能な装置番号の探査
    !  Search available unit number
    !----------------------------------------------------------------
    unit_work = max_unit
    do
      inquire(unit=unit_work, exist=unit_exist_flag, opened=unit_opend_flag)
      if (unit_exist_flag .and. .not. unit_opend_flag) then
        exit
      endif
      unit_work = unit_work - 1
      if (unit_work < min_unit) then
        cause_c = tochar(min_unit) // ' - ' // tochar(max_unit)
        stat = dc_enounitnum
        goto 999
      end if
    enddo
 
    !----------------------------------------------------------------
    !  モードの書式のチェック
    !  Check form of mode
    !----------------------------------------------------------------
    select case( trim(open_mode) )
    case ('r', 'w', 'rw', 'a', 'ra')
    case default
      cause_c = open_mode
      stat = dc_ebadfileopmode
      goto 999
    end select
 
    !----------------------------------------------------------------
    !  ファイルの存在のチェック
    !  Check existance of a file
    !----------------------------------------------------------------
    select case( trim(open_mode) )
    case ('r')
      inquire(file=file, exist=file_exist_flag)
      if (.not. file_exist_flag) then
        cause_c = file
        stat = dc_enofileexist
        goto 999
      end if
    end select
 
    !----------------------------------------------------------------
    !  ファイルの読み込み可能のチェック
    !  Check readable of a file
    !----------------------------------------------------------------
    select case( trim(open_mode) )
    case ('r')
      open(unit=unit_work, iostat=iostat, &
        & file=file, status='OLD', action='READ')
      if (.not. iostat == 0) then
        cause_c = file
        stat = dc_enofileread
        goto 999
      end if
      close(unit=unit_work)
    end select
 
    !----------------------------------------------------------------
    !  ファイルの書き込み可能のチェック
    !  Check writable of a file
    !----------------------------------------------------------------
    select case( trim(open_mode) )
    case ('w', 'a', 'rw', 'ra')
      open(unit=unit_work, iostat=iostat, &
        & file=file, status='UNKNOWN', action='WRITE')
      if (.not. iostat == 0) then
        cause_c = file
        stat = dc_enofilewrite
        goto 999
      end if
      close(unit=unit_work)
    end select
 
    !----------------------------------------------------------------
    !  ファイルオープン
    !  Open a file
    !----------------------------------------------------------------
    select case( trim(open_mode) )
    case ('r')
      open(unit=unit_work, file=file, &
        & status='OLD', action='READ')
 
    case ('w')
      open(unit=unit_work, file=file, &
        & status='REPLACE', action='WRITE')
 
    case ('rw')
      open(unit=unit_work, file=file, &
        & status='REPLACE', action='READWRITE')
 
    case ('a')
      open(unit=unit_work, file=file, &
        & status='UNKNOWN', position='APPEND', action='WRITE')
 
    case ('ra')
      open(unit=unit_work, file=file, &
        & status='UNKNOWN', position='APPEND', action='READWRITE')
 
    end select
 
    unit = unit_work
 
999 continue
    call storeerror(stat, subname, err, cause_c)
    call endsub(subname)
  end subroutine fileopen
 
  !> @namespace dc_iounit
end module dc_iounit