subroutine ANFileOpen(fileid, filename, writable, overwrite, stat, err)
implicit none
integer, intent(out):: fileid
character(len = *), intent(in):: filename
logical, intent(in), optional:: writable
! .TRUE. は上書モード .FALSE. は読込モード.
! - 上書モードでファイルが存在する場合エラーとする.
! - 読込モードでファイルが存在しない場合エラーとする.
logical, intent(in), optional:: overwrite
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
continue
!
! オプションの解釈
!
writable_required = .FALSE.
if (present(writable)) writable_required = writable
if (present(overwrite)) then
overwrite_required = overwrite
if (overwrite) writable_required = .TRUE.
else
overwrite_required = .FALSE.
endif
call beginsub('anfileopen', '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
call endsub('anfileopen', 'id=%d', i=(/fileid/))
return
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 (overwrite_required) then
mode = NF_NOCLOBBER
mystat = nf_create(real_filename, mode, memop%id)
! ファイルが既に存在している場合, エラーコードが返るので,
! そのエラーコードを用いて終了
if (present(err)) err = (mystat /= NF_NOERR)
call StoreError(mystat, 'ANFileOpen', err, cause_c=filename)
! 読み込みモードの場合は何もしない
endif
!
! ファイルが無かった場合
!
else
! 読み込みモードの場合
if (.not. overwrite_required) then
! 「無いよ」とエラーを吐いて終了
if (present(err)) err = (mystat /= NF_NOERR)
call StoreError(mystat, 'ANFileOpen', err, cause_c=filename)
! 書き込みモードの場合
else
mode = NF_CLOBBER
! ファイルを作成する
mystat = nf_create(real_filename, mode, memop%id)
if (present(err)) err = (mystat /= NF_NOERR)
call StoreError(mystat, 'ANFileOpen', err, cause_c=filename)
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
call StoreError(mystat, 'ANFileOpen', err, cause_c=filename)
endif
call endsub('anfileopen', 'id=%d stat=%d', i=(/fileid, mystat/))
end subroutine