!= ãƒ•ã‚¡ã‚¤ãƒ«ã‚ªãƒ¼ãƒ—ãƒ³æ™‚ã®è£…ç½®ç•ªå·å‡¦ç†
!
!= Unit number handling at file open
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dc_iounit.f90,v 1.1 2009-03-20 09:09:53 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2007. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!

module dc_iounit
  !
  != ãƒ•ã‚¡ã‚¤ãƒ«ã‚ªãƒ¼ãƒ—ãƒ³æ™‚ã®è£…ç½®ç•ªå·å‡¦ç†
  !
  != Unit number handling at file open
  !
  ! <b>Note that Japanese and English are described in parallel.</b>
  !
  ! ãƒ•ã‚¡ã‚¤ãƒ«ã‚’ã‚ªãƒ¼ãƒ—ãƒ³ã™ã‚‹éš›ã«ä½¿ç”¨ã™ã‚‹è£…ç½®ç•ªå·ã®å‡¦ç†ã‚’è¡Œã„ã¾ã™.
  ! ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ FileOpen ã«ãƒ•ã‚¡ã‚¤ãƒ«åã¨ã‚ªãƒ¼ãƒ—ãƒ³æ™‚ã®ãƒ¢ãƒ¼ãƒ‰ã‚’ä¸Žãˆã‚‹ã“ã¨ã§,
  ! åˆ©ç”¨å¯èƒ½ãªè£…ç½®ç•ªå·ã‚’å†…éƒ¨ã§æŽ¢æŸ»ã—,
  ! å†…éƒ¨ã§ãƒ•ã‚¡ã‚¤ãƒ«ã‚’ãƒ¢ãƒ¼ãƒ‰ã«åˆã‚ã›ã¦ã‚ªãƒ¼ãƒ—ãƒ³ã—ã¦ã‹ã‚‰, è£…ç½®ç•ªå·ã‚’è¿”ã—ã¾ã™.
  ! ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã¯, è£…ç½®ç•ªå·ã®ç®¡ç†ã‚„ãƒ•ã‚¡ã‚¤ãƒ«ã®èªã¿å–ã‚Š/æ›¸ãè¾¼ã¿å¯èƒ½
  ! ãªã©ã®ç¢ºèªä½œæ¥ã®ãŸã‚ã®ã‚½ãƒ¼ã‚¹ã‚³ãƒ¼ãƒ‰ã‚’ç°¡ç´ åŒ–ã—ã¾ã™.
  !
  ! 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.
  !
  !== Procedures List
  !
  ! FileOpen           :: ãƒ•ã‚¡ã‚¤ãƒ«åã¨ãƒ¢ãƒ¼ãƒ‰ã‚’ä¸Žãˆã‚‹ã“ã¨ã§ãƒ•ã‚¡ã‚¤ãƒ«ã‚’
  !                       ã‚ªãƒ¼ãƒ—ãƒ³ã—, è£…ç½®ç•ªå·ã‚’è¿”ã—ã¾ã™.
  ! ------------       :: ------------
  ! FileOpen           :: A file is opened and unit number is returned with
  !                       a filename and mode
  !
  !== Usage
  !
  ! ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã§æä¾›ã•ã‚Œã‚‹ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ FileOpen ã«
  ! ãƒ•ã‚¡ã‚¤ãƒ«åã¨ã‚ªãƒ¼ãƒ—ãƒ³æ™‚ã®ãƒ¢ãƒ¼ãƒ‰ã‚’ä¸Žãˆã¦ãã ã•ã„.
  ! ã™ã‚‹ã¨ãƒ•ã‚¡ã‚¤ãƒ«ãŒã‚ªãƒ¼ãƒ—ãƒ³ã•ã‚Œ, å¼•æ•° *unit* ã«è£…ç½®ç•ªå·ãŒè¿”ã‚Šã¾ã™.
  ! ãã®è£…ç½®ç•ªå·ã‚’ç”¨ã„, ãƒ•ã‚¡ã‚¤ãƒ«ã®å†…å®¹ã®èªã¿è¾¼ã¿ã‚„
  ! ãƒ•ã‚¡ã‚¤ãƒ«ã¸ã®æ›¸ãè¾¼ã¿ã‚’è¡Œã£ã¦ãã ã•ã„. èªã¿è¾¼ã¿ã‚„æ›¸ãè¾¼ã¿ã‚„ã‚¯ãƒãƒ¼ã‚ºã«ã¯
  ! Fortran çµ„ã¿è¾¼ã¿ã® READ æ–‡ã‚„ WRITE æ–‡, CLOSE æ–‡ã‚’ç”¨ã„ã¦ãã ã•ã„.
  !
  ! 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.
  !
  !=== Example
  !
  !    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
  !
  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

  subroutine FileOpen( &
    & unit, file, mode, &
    & err )
    !
    ! ãƒ•ã‚¡ã‚¤ãƒ«åã‚’ *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)
  end subroutine FileOpen

end module dc_iounit