gtdata_netcdf_internal Module Reference

Functions/Subroutines
integer function, public	vtable_add (var, entry)
integer function, public	vtable_delete (var)
integer function, public	vtable_lookup (var, entry)
integer function, public	vtable_set_attrid (var, attrid)

Variables
type(gd_nc_variable_entry), dimension(:), allocatable, target, save	gdnctab
integer, parameter	gdnctab_init_size = 16

Function/Subroutine Documentation

vtable_add()

integer function, public gtdata_netcdf_internal::vtable_add	(	type(gd_nc_variable), intent(out)	var,
		type(gd_nc_variable_search), intent(in)	entry
	)

Definition at line 34 of file gtdata_netcdf_internal.f90.

References dc_trace::dbgmessage(), gdnctab, gdnctab_init_size, and internal_build_dimids().

Referenced by gdncvarcreate(), gdncvarcreated(), gdncvaropen(), and gdncvaropenbydimord().

    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 = nf90_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 /= nf90_noerr) goto 999
    !
    result = nf90_noerr
    call dbgmessage('gtdata_netcdf_internal.add: added %d', i=(/var%id/))
    return
    !
999 continue
    var = gd_nc_variable(-1)
    result = nf90_enomem
    return

  contains

    subroutine internal_build_dimids(ent, stat)
!!      use netcdf, only: &
!!        & NF90_NOERR, NF90_ENOMEM, NF90_INQUIRE_VARIABLE
      type(gd_nc_variable_entry), intent(inout):: ent
      integer, intent(out):: stat
      integer:: ndims
      if (ent%varid > 0) then
        stat = nf90_inquire_variable(ent%fileid, ent%varid, ndims = ndims)
        if (stat /= nf90_noerr) return
        if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
        if (ndims == 0) then
          nullify(ent%dimids)
          stat = nf90_noerr
          return
        endif
        allocate(ent%dimids(ndims), stat=stat)
        if (stat /= 0) then
          stat = nf90_enomem
          return
        endif
        stat = nf90_inquire_variable(ent%fileid, ent%varid, dimids = ent%dimids)
        if (stat /= nf90_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 = nf90_enomem
          return
        endif
        ent%dimids(1) = ent%dimid
      endif
      stat = nf90_noerr
      return

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

Here is the call graph for this function:

Here is the caller graph for this function:

vtable_delete()

integer function, public gtdata_netcdf_internal::vtable_delete

(

type(gd_nc_variable), intent(in)

var

)

Definition at line 161 of file gtdata_netcdf_internal.f90.

References dc_trace::dbgmessage(), and gdnctab.

Referenced by gdncvarclose().

    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 = nf90_enotvar

Here is the call graph for this function:

Here is the caller graph for this function:

vtable_lookup()

integer function, public gtdata_netcdf_internal::vtable_lookup	(	type(gd_nc_variable), intent(in)	var,
		type(gd_nc_variable_entry), intent(out)	entry
	)

Definition at line 180 of file gtdata_netcdf_internal.f90.

References gdnctab.

Referenced by gdncattrgetchar(), gdncattrgetdouble(), gdncattrgetint(), gdncattrgetreal(), gdncattrinquire(), gdncattrinquireplus(), gdncsearchdim(), gdncvarattrcopy(), gdncvarattrnext(), gdncvarcreate(), gdncvardelattr(), gdncvargetattrlogical(), gdncvargetdouble(), gdncvargetint(), gdncvargetreal(), gdncvarinquire(), gdncvarinquireia(), gdncvaropenbydimord(), gdncvarputattrchar(), gdncvarputattrdouble(), gdncvarputattrint(), gdncvarputattrreal(), gdncvarputchar(), gdncvarputdouble(), gdncvarputint(), gdncvarputreal(), gdncvarsync(), and gdncvartostring().

    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 = nf90_noerr
    return
    !
999 continue
    nullify(entry%dimids)
    entry%fileid = -1
    entry%varid = -1
    entry%dimid = -1
    entry%attrid = -1
    result = nf90_enotvar

Here is the caller graph for this function:

vtable_set_attrid()

integer function, public gtdata_netcdf_internal::vtable_set_attrid	(	type(gd_nc_variable), intent(in)	var,
		integer, intent(in)	attrid
	)

Definition at line 199 of file gtdata_netcdf_internal.f90.

References gdnctab.

Referenced by gdncvarattrnext(), and gdncvarattrrewind().

    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 = nf90_noerr
    return
    !
999 continue
    result = nf90_enotvar

Here is the caller graph for this function:

Variable Documentation

gdnctab

type(gd_nc_variable_entry), dimension(:), allocatable, target, save gtdata_netcdf_internal::gdnctab

private

Definition at line 25 of file gtdata_netcdf_internal.f90.

Referenced by vtable_add(), vtable_delete(), vtable_lookup(), and vtable_set_attrid().

  type(gd_nc_variable_entry), save, target, allocatable:: gdnctab(:)

gdnctab_init_size

integer, parameter gtdata_netcdf_internal::gdnctab_init_size = 16

private

Definition at line 26 of file gtdata_netcdf_internal.f90.

Referenced by vtable_add().

  integer, parameter:: gdnctab_init_size = 16