| Class | gtdata_netcdf_internal |
| In: |
gtdata/gtdata_netcdf/gtdata_netcdf_internal.f90
|
Note that Japanese and English are described in parallel.
| Derived Type : | |||
| fileid : | integer
| ||
| varid : | integer
| ||
| dimid : | integer
| ||
| dimids(:) : | integer, pointer
| ||
| attrid : | integer
|
変数 (gtdata_netcdf_variable 実体) は (/fileid, varid, dimid/) で 同定される。正当な変数の fileid は必ず正である。
次元変数については自次元が、非次元変数については 自分にとっての次元の dimid の一覧が保存される。
Original external subprogram is gtdata_netcdf_types#GD_NC_VARIABLE_ENTRY
| Function : | |
| result : | integer |
| var : | type(GD_NC_VARIABLE), intent(out) |
| entry : | type(GD_NC_VARIABLE_SEARCH), intent(in) |
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
| Function : | |
| result : | integer |
| var : | type(GD_NC_VARIABLE), intent(in) |
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
| Function : | |
| result : | integer |
| var : | type(GD_NC_VARIABLE), intent(in) |
| entry : | type(GD_NC_VARIABLE_ENTRY), intent(out) |
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
| Function : | |
| result : | integer |
| var : | type(GD_NC_VARIABLE), intent(in) |
| attrid : | integer, intent(in) |
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
| Subroutine : | |
| ent : | type(GD_NC_VARIABLE_ENTRY), intent(inout) |
| stat : | integer, intent(out) |
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