Class an_file
In: an_file.f90

netCDF ファイルのオープンクローズ

Methods

Included Modules

dc_types dc_trace an_types netcdf_f77 dc_error dc_message

Attributes

Derived_Types  []  FILE_MEMO_ENTRY

Public Instance methods

Subroutine :
fileid :integer, intent(in)
err :logical, intent(out), optional

[Source]

  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
Function :
result :integer
fileid :integer, intent(in)

[Source]

  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
Function :
result :integer
fileid :integer, intent(in)

[Source]

  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
Subroutine :
fileid :integer, intent(out)
filename :character(len = *), intent(in)
writable :logical, intent(in), optional
: .TRUE. は書き込みモード、 .FALSE. は読込モード。 読込モードの際にファイルが ファイルが存在しないと エラーになる。 デフォルトは読み込みモード
overwrite :logical, intent(in), optional
: writable が .TRUE. の 場合のみ有効。 .TRUE. ならば上書きモード .FALSE. の場合、既存の ファイルが存在すると エラーになる
stat :integer, intent(out), optional
err :logical, intent(out), optional

[Source]

  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 :
fileid :integer, intent(in)
err :logical, intent(out), optional

[Source]

  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
Subroutine :
fileid :integer, intent(in), optional
stat :integer, intent(out), optional

[Source]

  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
inquire( fileid, name )
Subroutine :
fileid :integer, intent(in)
name :character(len = *), intent(out)

Alias for anfileinquirename

inquire( var, attrname, varid, nf_attrname )
Subroutine :
var :type(AN_VARIABLE), intent(in)
attrname :character(len=*), intent(in)
varid :integer, intent(out)
nf_attrname :character(len=*), intent(out)

Original external subprogram is anattrinquire.f90#ANAttrInquirePlus

Private Instance methods

FILE_MEMO_ENTRY
Derived Type :
id :integer
count :integer
writable :logical
filename :character(len = STRING)
next :type(FILE_MEMO_ENTRY), pointer
Subroutine :
fileid :integer, intent(in)
name :character(len = *), intent(out)

[Source]

  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
memo_head
Variable :
memo_head :type(FILE_MEMO_ENTRY), save, pointer
memo_used
Variable :
memo_used = .FALSE. :logical, save

[Validate]