! != 変数または属性に関する問い合わせ ! ! Authors:: Eizi TOYODA, Yasuhiro MORIKAWA ! Version:: $Id: anvarinquire.f90,v 1.2 2006/02/05 12:42:39 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20071009 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! ! 以下のサブルーチン、関数は an_generic から an_generic#Inquire ! として提供されます。 ! !-- ! 問い合わせは型ごとに手続をわけた。 !++ 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 ! 変数が1次元である場合、次元長 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