!
!= netCDF ファイルのオープンクローズ
!
! Authors:: Eizi TOYODA, Yasuhiro MORIKAWA
! Version:: $Id: an_file.f90,v 1.3 2006/01/23 01:18:22 morikawa Exp $
! Tag Name:: $Name: gt4f90io-20060627 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License:: See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides an_file
!
module an_file 20,4
!
!== 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 62
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) 1,6
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) 3,4
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) 4,8
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
!
! オプションの解釈
!
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
goto 999
end if
endif
! 読み込みモードの場合は何もしない
else
!
! ファイルが無かった場合
!
if (.not. writable_required) then
! 読み込みモードの場合
!
! 「無いよ」とエラーを吐いて終了
if (mystat /= NF_NOERR) then
cause_c=filename
goto 999
end if
else
! 書き込みモードの場合
mode = NF_CLOBBER
! ファイルを作成する
mystat = nf_create(real_filename, mode, memop%id)
if (mystat /= NF_NOERR) then
cause_c=filename
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) 1,6
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) 3,7
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) 8,2
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) 4,2
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