Class gtdata_netcdf_internal
In: gtdata/gtdata_netcdf/gtdata_netcdf_internal.f90

gtdata_netcdf 内で使用される内部向け定数, 変数, 手続き群

Internal constants, variables, procedures used in "gtdata_netcdf"

Note that Japanese and English are described in parallel.

Methods

GD_NC_VARIABLE_ENTRY   gdnctab   gdnctab_init_size   internal_build_dimids   vtable_add   vtable_delete   vtable_lookup   vtable_set_attrid  

Included Modules

gtdata_netcdf_types dc_error netcdf_f77 dc_trace

Public Instance methods

GD_NC_VARIABLE_ENTRY
Derived Type :
fileid :integer
: ID 情報
varid :integer
: ID 情報
dimid :integer
: ID 情報
dimids(:) :integer, pointer
: 次元表
attrid :integer
: 属性サーチ用イテレータ

gtdata_netcdf_internal モジュールの gdnctab 表の要素

ID 情報

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

次元表

次元変数については自次元が、非次元変数については 自分にとっての次元の dimid の一覧が保存される。

属性サーチ用イテレータ

Original external subprogram is gtdata_netcdf_types#GD_NC_VARIABLE_ENTRY

vtable_add( var, entry ) result(result)
Function :
result :integer
var :type(GD_NC_VARIABLE), intent(out)
entry :type(GD_NC_VARIABLE_SEARCH), intent(in)

[Source]

  integer function vtable_add(var, entry) result(result)
    type(GD_NC_VARIABLE), intent(out):: var
    type(GD_NC_VARIABLE_SEARCH), intent(in):: entry
    type(GD_NC_VARIABLE_ENTRY), allocatable:: tmp_table(:)
    integer:: i, n
    
    ! --- 必要なら初期確保 ---
    if (.not. allocated(gdnctab)) then
      allocate(gdnctab(gdnctab_init_size), stat=result)
      if (result /= 0) goto 999
      do, i = 1, gdnctab_init_size
        gdnctab(i)%fileid = 0
        gdnctab(i)%varid = 0
        gdnctab(i)%dimid = 0
        gdnctab(i)%attrid = 0
        nullify(gdnctab(i)%dimids)
      enddo
    endif
    ! --- 同じ内容が既登録ならばそれを返す (attrid は変更しない) ---
    do, i = 1, size(gdnctab)
      if (gdnctab(i)%fileid == entry%fileid .and. gdnctab(i)%varid == entry%varid .and. gdnctab(i)%dimid == entry%dimid) then
        var = GD_NC_VARIABLE(i)
        result = NF_NOERR
        call DbgMessage('gtdata_netcdf_internal.add: found %d', i=(/i/))
        return
      endif
    enddo
    !
    ! --- 空き地があればそこに割り当て ---
    var = GD_NC_VARIABLE(-1)
    do, i = 1, size(gdnctab)
      if (gdnctab(i)%fileid == 0) then
        var = GD_NC_VARIABLE(i)
        exit
      endif
    enddo
    if (var%id == -1) then
      ! --- 空き地はなかったのだから倍幅確保 ---
      n = size(gdnctab)
      allocate(tmp_table(n), stat=result)
      if (result /= 0) goto 999
      tmp_table(:) = gdnctab(:)
      deallocate(gdnctab, stat=result)
      if (result /= 0) goto 999
      allocate(gdnctab(n * 2), stat=result)
      if (result /= 0) goto 999
      gdnctab(1:n) = tmp_table(1:n)
      deallocate(tmp_table, stat=result)
      if (result /= 0) goto 999
      !
      gdnctab(n+2)%fileid = 0
      gdnctab(n+2)%varid = 0
      gdnctab(n+2)%dimid = 0
      gdnctab(n+2)%attrid = 0
      nullify(gdnctab(n+2)%dimids)
      gdnctab(n+3: n*2) = gdnctab(n+2)
      ! 確保域の先頭を使用
      var = GD_NC_VARIABLE(n + 1)
    endif
    gdnctab(var%id)%fileid = entry%fileid
    gdnctab(var%id)%varid = entry%varid
    gdnctab(var%id)%dimid = entry%dimid
    !
    ! --- 次元表の確保 ---
    call internal_build_dimids(gdnctab(var%id), result)
    if (result /= nf_noerr) goto 999
    !
    result = nf_noerr
    call DbgMessage('gtdata_netcdf_internal.add: added %d', i=(/var%id/))
    return
    !
999 continue
    var = GD_NC_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(GD_NC_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 internal_build_dimids
    
  end function vtable_add
vtable_delete( var ) result(result)
Function :
result :integer
var :type(GD_NC_VARIABLE), intent(in)

[Source]

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

[Source]

  integer function vtable_lookup(var, entry) result(result)
    type(GD_NC_VARIABLE), intent(in):: var
    type(GD_NC_VARIABLE_ENTRY), intent(out):: entry
    if (.not. allocated(gdnctab)) goto 999
    if (var%id <= 0 .or. var%id > size(gdnctab)) goto 999
    if (gdnctab(var%id)%fileid == 0) goto 999
    entry = gdnctab(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 vtable_lookup
vtable_set_attrid( var, attrid ) result(result)
Function :
result :integer
var :type(GD_NC_VARIABLE), intent(in)
attrid :integer, intent(in)

[Source]

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

Private Instance methods

gdnctab
Variable :
gdnctab(:) :type(GD_NC_VARIABLE_ENTRY), save, target, allocatable
gdnctab_init_size
Constant :
gdnctab_init_size = 16 :integer, parameter
internal_build_dimids( ent, stat )
Subroutine :
ent :type(GD_NC_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(GD_NC_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 internal_build_dimids

[Validate]