Class an_file
In: an_file.f90

Methods

ANFileClose   ANFileDataMode   ANFileDefineMode   ANFileOpen   ANFileReopen   ANFileSync   FILE_MEMO_ENTRY   anfileinquirename   inquire   inquire   memo_head   memo_used  

Included Modules

dc_types dc_trace an_types netcdf_f77 dc_error

Attributes

Derived_Types  []  FILE_MEMO_ENTRY

Public Instance methods

ANFileClose( fileid, [err] )
Subroutine :
fileid :integer, intent(in)
err :logical, intent(out), optional

[Source]

    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
ANFileDataMode( fileid ) result(result)
Function :
result :integer
fileid :integer, intent(in)

[Source]

    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
ANFileDefineMode( fileid ) result(result)
Function :
result :integer
fileid :integer, intent(in)

[Source]

    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
ANFileOpen( fileid, filename, [writable], [overwrite], [stat], [err] )
Subroutine :
fileid :integer, intent(out)
filename :character(len = *), intent(in)
writable :logical, intent(in), optional
: .TRUE. は上書モード .FALSE. は読込モード. 
  - 上書モードでファイルが存在する場合エラーとする.
  - 読込モードでファイルが存在しない場合エラーとする.
overwrite :logical, intent(in), optional
stat :integer, intent(out), optional
err :logical, intent(out), optional

[Source]

    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_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
        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
ANFileReopen( fileid, [err] )
Subroutine :
fileid :integer, intent(in)
err :logical, intent(out), optional

[Source]

    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
ANFileSync( [fileid], [stat] )
Subroutine :
fileid :integer, intent(in), optional
stat :integer, intent(out), optional

[Source]

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

Alias for anfileinquirename

inquire( var, attrname, varid, nf_attrname )
Subroutine :
var :type(AN_VARIABLE), intent(in)
attrname :character(len=*), intent(in)
varid :integer, intent(out)
nf_attrname :character(len=*), intent(out)

The entity is anattrinquire.f90#ANAttrInquirePlus

Private Instance methods

FILE_MEMO_ENTRY()
Derived Type :
id :integer
count :integer
writable :logical
filename :character(len = string)
next :type(FILE_MEMO_ENTRY), pointer
anfileinquirename( fileid, name )
Subroutine :
fileid :integer, intent(in)
name :character(len = *), intent(out)

[Source]

    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
memo_head()
Variable :
memo_head :type(FILE_MEMO_ENTRY), save, pointer
memo_used()
Variable :
memo_used = .FALSE. :logical, save

[Validate]