Class | an_file |
In: |
an_file.f90
|
Derived_Types | [] | FILE_MEMO_ENTRY |
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 ! ! オプションの解釈 ! 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 : | |
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 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