dc_iounit Module Reference

Data Types
interface	fileopen

Functions/Subroutines
subroutine, public	fileopen (unit, file, mode, err)

Function/Subroutine Documentation

fileopen()

subroutine, public dc_iounit::fileopen	(	integer, intent(out)	unit,
		character(*), intent(in)	file,
		character(*), intent(in), optional	mode,
		logical, intent(out), optional	err
	)

Definition at line 100 of file dc_iounit.f90.

    !
    ! ファイル名を *file* へ, オープンする際のモードを *mode* へと
    ! 与えることで, ファイルをオープンし, 装置番号を *unit* に返します. 
    ! *mode* には以下の文字列を指定します. 省略時は "r" が指定されたもの
    ! とみなします. 
    !
    ! "r"  :: ファイルを読み込みモードでオープンします.
    ! "w"  :: ファイルを書き込みモードでオープンします. 
    !         オープン時にファイルがすでに存在していればその内容を空にします.
    ! "a"  :: ファイルを書き込みモードでオープンします. 
    !         出力はファイルの末尾に追加されます.
    ! "rw" :: ファイルを読み書き両用モードでオープンします. 
    !         オープン時にファイルがすでに
    !         存在していればその内容を空にします.
    ! "ra" :: ファイルを読み書き両用モードでオープンします. 
    !         オープン時にファイルがすでに
    !         存在していれば読み書き位置がファイルの末尾にセットされます.
    !
    ! ファイルが *mode* で指定されるモードで開けない場合, プログラムは
    ! 強制終了します. 引数 *err* が与えられる場合, プログラムは強制終了せず, 
    ! 代わりに *err* に .true. が, *unit* に -1 が代入されます. 
    !
    ! Filename is given to *file*, and open mode is given to *mode*, 
    ! then the file is opened and unit number is returned.
    !
    ! "r"  :: A file is opened with read-only mode
    ! "w"  :: A file is opened with writable mode. 
    !         If a file is exist already, the contest 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 contest 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. 
    !
    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)