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)

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 33 of file gtdata_netcdf_internal.f90.

    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
 

vtable_delete()

integer function, public gtdata_netcdf_internal::vtable_delete

(

type(gd_nc_variable), intent(in)

var

)

Definition at line 160 of file gtdata_netcdf_internal.f90.

    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

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 179 of file gtdata_netcdf_internal.f90.

    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

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 198 of file gtdata_netcdf_internal.f90.

    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