!
!= netCDF ファイルのオープンクローズ
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: an_file.f90,v 1.4 2007/08/24 07:21:19 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20070914 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides an_file
!

module an_file
  !
  !== netCDF ファイルのオープンクローズ
  !
  use dc_types, only: STRING
  use dc_trace, only: BeginSub, EndSub, DbgMessage

  implicit none
  private

  type FILE_MEMO_ENTRY
    integer:: id
    integer:: count
    logical:: writable
    character(len = STRING):: filename
    type(FILE_MEMO_ENTRY), pointer:: next
  end type FILE_MEMO_ENTRY

  type(FILE_MEMO_ENTRY), save, pointer:: memo_head
  logical, save:: memo_used = .FALSE.

  public:: ANFileOpen, ANFileClose, ANFileReopen
  public:: ANFileDataMode, ANFileDefineMode, ANFileSync
  public:: Inquire

  ! 非公開なので an_generic には置かない
  interface inquire
    subroutine ANAttrInquirePlus(var, attrname, varid, nf_attrname)
      use an_types, only: AN_VARIABLE
      type(AN_VARIABLE), intent(in):: var
      character(len=*), intent(in):: attrname
      integer, intent(out):: varid
      character(len=*), intent(out):: nf_attrname
    end subroutine ANAttrInquirePlus

    module procedure anfileinquirename
  end interface

contains

  subroutine anfileinquirename(fileid, name)
    use netcdf_f77, only: NF_ENOTNC
    use dc_error
    integer, intent(in):: fileid
    character(len = *), intent(out):: name
    type(FILE_MEMO_ENTRY), pointer:: memop
  continue
    call BeginSub('anfilename', 'fileid=%d', i=(/fileid/))
    if (.not. memo_used) goto 999
    memop => memo_head
    do
      if (.not. associated(memop)) exit
      if (memop%id == fileid) then
        name = memop%filename
        call EndSub('anfilename', 'name=<%c>', c1=trim(name))
        return
      endif
      memop => memop%next
    enddo
999 continue
    call StoreError(NF_ENOTNC, "ANFileName")
    call EndSub('anfilename', 'err')
  end subroutine anfileinquirename

  subroutine ANFileSync(fileid, stat)
    use netcdf_f77, only: nf_sync, NF_NOERR
    use dc_error
    integer, intent(in), optional:: fileid
    integer, intent(out), optional:: stat
    integer:: ncid, mystat
    type(FILE_MEMO_ENTRY), pointer:: memop
    mystat = NF_NOERR
    if (present(fileid)) then
      ncid = fileid
      mystat = ANFileDataMode(ncid)
      if (mystat /= NF_NOERR) goto 999
      mystat = nf_sync(ncid)
    else if (memo_used) then
      memop => memo_head
      do
        if (.not. associated(memop)) exit
        ncid = memop%id
        mystat = ANFileDataMode(ncid)
        if (mystat /= NF_NOERR) exit
        mystat = nf_sync(ncid)
        if (mystat /= NF_NOERR) exit
        memop => memop%next
      enddo
    endif
999 continue
    ! 自発的には StoreError しない。StoreError の SysdepAbort
    ! からも呼ばれる可能性があるためである。
    if (present(stat)) stat = mystat
  end subroutine ANFileSync

  subroutine ANFileOpen(fileid, filename, writable, overwrite, stat, err)
    use netcdf_f77, only: NF_WRITE, NF_NOWRITE, NF_ENOTNC, &
      & NF_NOERR, NF_NOCLOBBER, NF_CLOBBER, NF_OPEN, NF_CREATE
    use dc_message, only: MessageNotify
    use dc_error, only: StoreError
    implicit none
    integer, intent(out):: fileid
    character(len = *), intent(in):: filename
    logical, intent(in), optional:: writable
                                        ! .TRUE. は書き込みモード、
                                        ! .FALSE. は読込モード。
                                        ! 読込モードの際にファイルが
                                        ! ファイルが存在しないと
                                        ! エラーになる。
                                        ! デフォルトは読み込みモード
    logical, intent(in), optional:: overwrite
                                        ! writable が .TRUE. の
                                        ! 場合のみ有効。
                                        ! .TRUE. ならば上書きモード
                                        ! .FALSE. の場合、既存の
                                        ! ファイルが存在すると
                                        ! エラーになる
    logical, intent(out), optional:: err
    integer, intent(out), optional:: stat
    logical:: writable_required
    logical:: overwrite_required
    type(FILE_MEMO_ENTRY), pointer:: memop, prev
    integer:: mystat, mode
    character(len = 256):: real_filename
    character(len = STRING):: cause_c
    character(*), parameter:: subname = "ANFileOpen"
  continue
    fileid = -1
    !
    ! オプションの解釈
    !
    writable_required = .FALSE.
    overwrite_required = .FALSE.
    if (present(writable)) writable_required = writable
    if (present(overwrite)) overwrite_required = overwrite
    call BeginSub(subname, 'writable=%y overwrite=%y file=%c', &
      & L=(/writable_required, overwrite_required/), c1=trim(filename))
    !
    ! 同じ名前で書込み可能性も適合していれば nf_open しないで済ませる
    !
    if (memo_used) then
      memop => memo_head
      nullify(prev)
      do
        if ((memop%filename == filename) &
          & .and. (memop%writable .or. .not. writable_required)) then
          fileid = memop%id
          memop%count = memop%count + 1
          if (present(err)) err = .FALSE.
          if (present(stat)) stat = NF_NOERR
          mystat = NF_NOERR
          goto 999
        endif
        prev => memop
        memop => memop%next
        if (.not. associated(memop)) exit
      enddo
      allocate(memop)
      prev%next => memop
    else
      nullify(prev)
      allocate(memo_head)
      memop => memo_head
      memo_used = .TRUE.
    endif
    nullify(memop%next)
    memop%filename = filename
    memop%writable = writable_required
    memop%count = 1
    !
    ! URL の部分的サポート
    !
    real_filename = filename
    if (real_filename(1:8) == 'file:///') then
      real_filename = real_filename(8: )
    else if (real_filename(1:5) == 'file:' .AND. real_filename(6:6) /= '/') then
      real_filename = real_filename(6: )
    endif
    !
    ! いざ nf_open
    !
    mode = NF_NOWRITE
    if (writable_required) mode = ior(mode, NF_WRITE)
    ! 既に nc ファイルがあると思って開けてみる
    mystat = nf_open(real_filename, mode, memop%id)
    !
    ! ファイルが既に存在する場合
    !
    if (mystat == NF_NOERR) then
      ! 書き込みモードの場合
      if (writable_required) then
        if (overwrite_required) then
          ! 上書きモードの場合
          mode = NF_CLOBBER
          call MessageNotify("M", subname, &
            & "%c is overwritten.", c1=trim(filename))
        else
          ! 上書き禁止モードの場合
          mode = NF_NOCLOBBER
          call MessageNotify("W", subname, &
            & "%c is opened in write-protect mode.", c1=trim(filename))
        end if
        mystat = nf_create(real_filename, mode, memop%id)
        if (mystat /= NF_NOERR) then
          cause_c=filename
          if (present(stat)) stat = mystat
          goto 999
        end if
      endif
      ! 読み込みモードの場合は何もしない
    else
      !
      ! ファイルが無かった場合
      !
      if (.not. writable_required) then
        ! 読み込みモードの場合
        !
        ! 「無いよ」とエラーを吐いて終了
        if (mystat /= NF_NOERR) then
          cause_c=filename
          if (present(stat)) stat = mystat
          goto 999
        end if
      else
        ! 書き込みモードの場合
        mode = NF_CLOBBER
        ! ファイルを作成する
        mystat = nf_create(real_filename, mode, memop%id)
        if (mystat /= NF_NOERR) then
          cause_c=filename
          if (present(stat)) stat = mystat
          goto 999
        end if
      endif
    endif

    fileid = memop%id

    ! 失敗したら消しておく
    if (mystat /= NF_NOERR) then
      if (associated(prev)) then
        prev%next => memop%next
      else
        memo_head => memop%next
        if (.not. associated(memo_head)) memo_used = .FALSE.
      endif
      deallocate(memop)
      fileid = -1
    endif

    if (present(stat)) then
      stat = mystat
      if (present(err)) err = (stat /= NF_NOERR)
    else
      cause_c=filename
      goto 999
    endif
999 continue
    call StoreError(mystat, subname, err, cause_c)
    call EndSub(subname, 'id=%d stat=%d', i=(/fileid, mystat/))
  end subroutine ANFileOpen

  ! 同じファイル番号の参照カウントを増加する。
  subroutine ANFileReopen(fileid, err)
    use netcdf_f77
    use dc_error, only: StoreError
    implicit none
    integer, intent(in):: fileid
    logical, intent(out), optional:: err
    type(FILE_MEMO_ENTRY), pointer:: memop
  continue
    call BeginSub('anfilereopen', 'file=%d', i=(/fileid/))
    if (memo_used) then
      memop => memo_head
      do
        if (memop%id == fileid) then
          memop%count = memop%count + 1
          if (present(err)) err = .FALSE.
          call EndSub('anfilereopen', 'count=%d', i=(/memop%count/))
          return
        endif
        memop => memop%next
        if (.not. associated(memop)) exit
      enddo
    endif
    call StoreError(NF_ENOTNC, 'ANFileReopen', err, cause_i=fileid)
    call EndSub('anfilereopen', 'err')
  end subroutine ANFileReopen

  ! おなじ id のファイルの参照カウンタを減算し、ゼロになったら閉じる
  subroutine ANFileClose(fileid, err)
    use netcdf_f77, only: NF_CLOSE, NF_ENOTNC, NF_NOERR
    use dc_error, only: StoreError
    integer, intent(in):: fileid
    logical, intent(out), optional:: err
    type(FILE_MEMO_ENTRY), pointer:: memop, prev
    integer:: stat
  continue
    call BeginSub('anfileclose')
    stat = NF_ENOTNC
    if (.not. memo_used) goto 999
    memop => memo_head
    nullify(prev)
    do
      if (.not. associated(memop)) goto 999
      if (memop%id == fileid) exit
      prev => memop
      memop => memop%next
    enddo
    memop%count = memop%count - 1
    if (memop%count <= 0) then
      stat = nf_close(fileid)
      if (associated(prev)) then
        prev%next => memop%next
      else
        memo_head => memop%next
        if (.not. associated(memo_head)) memo_used = .FALSE.
      endif
      call DbgMessage('anfileclose: <%c> closed', c1=trim(memop%filename))
      deallocate(memop)
    else
      call DbgMessage('anfileclose: %d<%c> skipped for refcount=%d', &
        & c1=trim(memop%filename), i=(/fileid, memop%count/))
      stat = NF_NOERR
    endif
999 continue
    call EndSub('anfileclose')
    call StoreError(stat, 'ANFileClose', err)
  end subroutine ANFileClose

  integer function ANFileDefineMode(fileid) result(result)
    use netcdf_f77, only: nf_redef, NF_EINDEFINE, NF_NOERR
    integer, intent(in):: fileid
    call DbgMessage('anfiledefinemode %d', i=(/fileid/))
    result = nf_redef(fileid)
    if (result == NF_EINDEFINE) result = NF_NOERR
  end function ANFileDefineMode

  integer function ANFileDataMode(fileid) result(result)
    use netcdf_f77, only: nf_enddef, NF_ENOTINDEFINE, NF_NOERR
    integer, intent(in):: fileid
    call DbgMessage('anfiledefinemode')
    result = nf_enddef(fileid)
    if (result == NF_ENOTINDEFINE) result = NF_NOERR
  end function ANFileDataMode

end module an_file
