subroutine ANVarInquire(var, ndims, dimlen, growable, name, url, xtype)
use an_types, only: an_variable, an_variable_entry
use an_file, only: inquire
use an_vartable, only: vtable_lookup
use an_generic, only: ANXTypeName
use dc_trace, only: beginsub, endsub, DbgMessage
use netcdf_f77, only: nf_noerr, nf_max_name, nf_inq_vartype, nf_inq_dimlen, nf_inq_unlimdim
implicit none
type(an_variable), intent(in):: var
integer, intent(out), optional:: ndims
! 変数の次元数
integer, intent(out), optional:: dimlen
! 変数が１次元である場合、次元長
logical, intent(out), optional:: growable
! 変数が成長可能次元を持つか
character(*), intent(out), optional:: name
! 文字型引数が短いと値の切り詰めが起こりうる。'?' のあとの変数名
character(*), intent(out), optional:: url
! 変数名、少なくともファイル名を含む、なるべく長い名前
character(*), intent(out), optional:: xtype
! 変数の型名
! 内部変数
type(an_variable_entry):: ent
integer:: stat, length, i, i_xtype, idim_growable
character(len = *), parameter:: subname = 'anvarinqurie'
character(len = nf_max_name):: buffer
character(len = nf_max_name):: fbuffer
continue
call beginsub(subname, 'var.id=%d', i=(/var%id/))
! フェイルセーフ用にエラー値をまず入れる
if (present(ndims)) ndims = -1
if (present(dimlen)) dimlen = -1
! 変数実体の探索
stat = vtable_lookup(var, ent)
if (stat /= nf_noerr) then
call endsub(subname, 'var not found')
return
endif
! 各引数が与えられている場合について値を取得する動作を
if (present(ndims)) then
if (associated(ent%dimids)) then
ndims = size(ent%dimids)
else
ndims = 0
endif
endif
if (present(dimlen)) then
dimlen = 1
if (ent%dimid > 0) then
! 実体に次元としての問い合わせが可能な場合
stat = nf_inq_dimlen(ent%fileid, ent%dimid, dimlen)
if (stat /= nf_noerr) then
dimlen = -1
call endsub(subname, 'dimlen err')
return
endif
else
! 実体が変数として問い合わせるしかない場合
if (associated(ent%dimids)) then
do, i = 1, size(ent%dimids)
stat = nf_inq_dimlen(ent%fileid, ent%dimids(i), length)
if (stat /= nf_noerr) then
dimlen = -1
exit
endif
dimlen = dimlen * length
enddo
endif
endif
endif
if (present(xtype)) then
stat = nf_inq_vartype(ent%fileid, ent%varid, xtype=i_xtype)
if (stat /= NF_NOERR) i_xtype = 0
call ANXTypeName(i_xtype, xtype)
endif
if (present(name)) then
call local_getname(ent, buffer)
name = buffer
endif
if (present(url)) then
call local_getname(ent, buffer)
call DbgMessage('ent%%fileid=%d', i=(/ent%fileid/))
call inquire(ent%fileid, name=fbuffer)
url = trim(fbuffer) // '?' // buffer
endif
if (present(growable)) then
growable = .false.
stat = vtable_lookup(var, ent)
if (stat /= nf_noerr) return
stat = nf_inq_unlimdim(ent%fileid, idim_growable)
if (stat /= nf_noerr) return
if (ent%varid > 0) then
if (.not. associated(ent%dimids)) return
do, i = 1, size(ent%dimids)
if (ent%dimids(i) == idim_growable) growable = .true.
enddo
else
growable = (ent%dimid == idim_growable)
endif
endif
! 安全に終った
call endsub(subname, 'ok')
return
contains
subroutine local_getname(ent, varname)
use netcdf_f77, only: nf_inq_varname, nf_inq_dimname
type(an_variable_entry), intent(in):: ent
character(len = *), intent(out):: varname
if (ent%dimid > 0) then
stat = nf_inq_dimname(ent%fileid, ent%dimid, varname)
else
stat = nf_inq_varname(ent%fileid, ent%varid, varname)
endif
if (stat /= NF_NOERR) varname = ""
end subroutine local_getname
end subroutine ANVarInquire