| Class | an_file |
| In: |
abst_netcdf/an_file.f90
|
| Subroutine : | |
| fileid : | integer, intent(in) |
| err : | logical, intent(out), optional |
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) |
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) |
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
| ||
| overwrite : | logical, intent(in), optional
| ||
| stat : | integer, intent(out), optional | ||
| err : | logical, intent(out), optional |
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), rank_mpi = -1)
else
! 上書き禁止モードの場合
mode = NF_NOCLOBBER
call MessageNotify('W', subname, '"%c" is opened in write-protect mode.', c1=trim(filename), rank_mpi = -1)
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 |
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 |
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 : | |
| fileid : | integer, intent(in) |
| name : | character(len = *), intent(out) |
Alias for anfileinquirename
| 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 abst_netcdf/anattrinquire.f90#ANAttrInquirePlus
| 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) |
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