Class an_file
In: src/an_file.f90

Methods

Included Modules

dc_types dc_trace an_types netcdf_f77 dc_error

Public Instance methods

result :integer
fileid :integer, intent(in)

おなじ id のファイルの参照カウンタを減算し、ゼロになったら閉じる

[Source]



    integer function ANFileDataMode(fileid) result(result)

        integer, intent(in):: fileid
        call DbgMessage('anfiledefinemode')
        result = nf_enddef(fileid)
        if (result == NF_ENOTINDEFINE) result = NF_NOERR
    end function
fileid :integer, intent(out)
filename :character(len = *), intent(in)
writable :logical, intent(in), optional
overwrite :logical, intent(in), optional
: .TRUE. は上書モード .FALSE. は読込モード.
  - 上書モードでファイルが存在する場合エラーとする.
  - 読込モードでファイルが存在しない場合エラーとする.
stat :integer, intent(out), optional
err :logical, intent(out), optional

[Source]



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

[Source]


    subroutine anfileinquirename(fileid, name)

        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
inquire(var, attrname, varid, nf_attrname)

[Validate]