Class an_vartable
In: an_vartable.f90

Methods

Included Modules

an_types dc_error netcdf_f77 dc_trace

Public Instance methods

AN_VARIABLE_ENTRY()
Derived Type :
fileid :integer
varid :integer
dimid :integer
: 次元表
       次元変数については自次元が、非次元変数については
       自分にとっての次元の dimid の一覧が保存される。
dimids(:) :integer, pointer
: 属性サーチ用イテレータ
attrid :integer

ID 情報

       変数 (an_variable 実体) は (/fileid, varid, dimid/) で
        同定される。正当な変数の fileid は必ず正である。

Original external subprogram is an_types#AN_VARIABLE_ENTRY

AN_VARIABLE_ENTRY()
Derived Type :
fileid :integer
varid :integer
dimid :integer
: 次元表
       次元変数については自次元が、非次元変数については
       自分にとっての次元の dimid の一覧が保存される。
dimids(:) :integer, pointer
: 属性サーチ用イテレータ
attrid :integer

ID 情報

       変数 (an_variable 実体) は (/fileid, varid, dimid/) で
        同定される。正当な変数の fileid は必ず正である。

Original external subprogram is an_types#AN_VARIABLE_ENTRY

Function :
result :integer
var :type(an_variable), intent(out)
entry :type(an_variable_search), intent(in)

[Source]

    integer function vtable_add(var, entry) result(result)
        type(an_variable), intent(out):: var
        type(an_variable_search), intent(in):: entry
        type(an_variable_entry), allocatable:: tmp_table(:)
        integer:: i, n

        ! --- 必要なら初期確保 ---
        if (.not. allocated(antab)) then
            allocate(antab(antab_init_size), stat=result)
            if (result /= 0) goto 999
            do, i = 1, antab_init_size
                antab(i)%fileid = 0
                antab(i)%varid = 0
                antab(i)%dimid = 0
                antab(i)%attrid = 0
                nullify(antab(i)%dimids)
            enddo
        endif
        ! --- 同じ内容が既登録ならばそれを返す (attrid は変更しない) ---
        do, i = 1, size(antab)
            if (antab(i)%fileid == entry%fileid .and. antab(i)%varid == entry%varid .and. antab(i)%dimid == entry%dimid) then
                var = an_variable(i)
                result = NF_NOERR
                call DbgMessage('an_vartable.add: found %d', i=(/i/))
                return
            endif
        enddo
        !
        ! --- 空き地があればそこに割り当て ---
        var = an_variable(-1)
        do, i = 1, size(antab)
            if (antab(i)%fileid == 0) then
                var = an_variable(i)
                exit
            endif
        enddo
        if (var%id == -1) then
            ! --- 空き地はなかったのだから倍幅確保 ---
            n = size(antab)
            allocate(tmp_table(n), stat=result)
            if (result /= 0) goto 999
            tmp_table(:) = antab(:)
            deallocate(antab, stat=result)
            if (result /= 0) goto 999
            allocate(antab(n * 2), stat=result)
            if (result /= 0) goto 999
            antab(1:n) = tmp_table(1:n)
            deallocate(tmp_table, stat=result)
            if (result /= 0) goto 999
            !
            antab(n+2)%fileid = 0
            antab(n+2)%varid = 0
            antab(n+2)%dimid = 0
            antab(n+2)%attrid = 0
            nullify(antab(n+2)%dimids)
            antab(n+3: n*2) = antab(n+2)
            ! 確保域の先頭を使用
            var = an_variable(n + 1)
        endif
        antab(var%id)%fileid = entry%fileid
        antab(var%id)%varid = entry%varid
        antab(var%id)%dimid = entry%dimid
        !
        ! --- 次元表の確保 ---
        call internal_build_dimids(antab(var%id), result)
        if (result /= nf_noerr) goto 999
        !
        result = nf_noerr
        call DbgMessage('an_vartable.add: added %d', i=(/var%id/))
        return
        !
    999 continue
        var = an_variable(-1)
        result = NF_ENOMEM
        return

    contains

        subroutine internal_build_dimids(ent, stat)
            use netcdf_f77, only: nf_noerr, nf_inq_varndims, nf_inq_vardimid
            type(an_variable_entry), intent(inout):: ent
            integer, intent(out):: stat
            integer:: ndims
            if (ent%varid > 0) then
                stat = nf_inq_varndims(ent%fileid, ent%varid, ndims)
                if (stat /= nf_noerr) return
                if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
                if (ndims == 0) then
                    nullify(ent%dimids)
                    stat = nf_noerr
                    return
                endif
                allocate(ent%dimids(ndims), stat=stat)
                if (stat /= 0) then
                    stat = nf_enomem
                    return
                endif
                stat = nf_inq_vardimid(ent%fileid, ent%varid, ent%dimids)
                if (stat /= nf_noerr) return
                if ((ent%dimid > 0) .and. (ent%dimids(1) /= ent%dimid)) then
                    deallocate(ent%dimids)
                    goto 100
                endif
            else
                allocate(ent%dimids(1), stat=stat)
                if (stat /= 0) then
                    stat = nf_enomem
                    return
                endif
                ent%dimids(1) = ent%dimid
            endif
            stat = nf_noerr
            return

        100 continue
            ent%varid = 0
            allocate(ent%dimids(1))
            ent%dimids(1) = ent%dimid
        end subroutine

    end function
Function :
result :integer
var :type(an_variable), intent(in)

[Source]

    integer function vtable_delete(var) result(result)
        type(an_variable), intent(in):: var
        if (.not. allocated(antab)) goto 999
        if (var%id <= 0 .or. var%id > size(antab)) goto 999
        if (antab(var%id)%fileid == 0) goto 999
        result = antab(var%id)%fileid
        antab(var%id)%fileid = 0
        antab(var%id)%varid = 0
        antab(var%id)%dimid = 0
        antab(var%id)%attrid = 0
        if (associated(antab(var%id)%dimids)) deallocate(antab(var%id)%dimids)
        call DbgMessage('an_vartable.delete: delete %d', i=(/var%id/))
        return
        !
    999 continue
        result = NF_ENOTVAR
    end function
Function :
result :integer
var :type(an_variable), intent(in)
entry :type(an_variable_entry), intent(out)

[Source]

    integer function vtable_lookup(var, entry) result(result)
        type(an_variable), intent(in):: var
        type(an_variable_entry), intent(out):: entry
        if (.not. allocated(antab)) goto 999
        if (var%id <= 0 .or. var%id > size(antab)) goto 999
        if (antab(var%id)%fileid == 0) goto 999
        entry = antab(var%id)
        result = NF_NOERR
        return
        !
    999 continue
        nullify(entry%dimids)
        entry%fileid = -1
        entry%varid = -1
        entry%dimid = -1
        entry%attrid = -1
        result = NF_ENOTVAR
    end function
Function :
result :integer
var :type(an_variable), intent(in)
attrid :integer, intent(in)

[Source]

    integer function vtable_set_attrid(var, attrid) result(result)
        type(an_variable), intent(in):: var
        integer, intent(in):: attrid
    continue
        if (.not. allocated(antab)) goto 999
        if (var%id <= 0 .or. var%id > size(antab)) goto 999
        if (antab(var%id)%fileid == 0) goto 999
        antab(var%id)%attrid = attrid
        result = NF_NOERR
        return
        !
    999 continue
        result = NF_ENOTVAR
    end function

Private Instance methods

antab()
Variable :
antab(:) :type(an_variable_entry), save, target, allocatable
antab_init_size()
Constant :
antab_init_size = 16 :integer, parameter
Subroutine :
ent :type(an_variable_entry), intent(inout)
stat :integer, intent(out)

[Source]

        subroutine internal_build_dimids(ent, stat)
            use netcdf_f77, only: nf_noerr, nf_inq_varndims, nf_inq_vardimid
            type(an_variable_entry), intent(inout):: ent
            integer, intent(out):: stat
            integer:: ndims
            if (ent%varid > 0) then
                stat = nf_inq_varndims(ent%fileid, ent%varid, ndims)
                if (stat /= nf_noerr) return
                if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
                if (ndims == 0) then
                    nullify(ent%dimids)
                    stat = nf_noerr
                    return
                endif
                allocate(ent%dimids(ndims), stat=stat)
                if (stat /= 0) then
                    stat = nf_enomem
                    return
                endif
                stat = nf_inq_vardimid(ent%fileid, ent%varid, ent%dimids)
                if (stat /= nf_noerr) return
                if ((ent%dimid > 0) .and. (ent%dimids(1) /= ent%dimid)) then
                    deallocate(ent%dimids)
                    goto 100
                endif
            else
                allocate(ent%dimids(1), stat=stat)
                if (stat /= 0) then
                    stat = nf_enomem
                    return
                endif
                ent%dimids(1) = ent%dimid
            endif
            stat = nf_noerr
            return

        100 continue
            ent%varid = 0
            allocate(ent%dimids(1))
            ent%dimids(1) = ent%dimid
        end subroutine

[Validate]