gtvarinquire.f90

Path: gtvarinquire.f90
Last Update: Sun Jan 15 16:10:30 JST 2006

変数または属性に関する問い合わせ

Authors:Eizi TOYODA, Yasuhiro MORIKAWA
Version:$Id: gtvarinquire.f90,v 1.3 2006/01/15 07:10:30 morikawa Exp $
Tag Name:$Name: gt4f90io-20070729 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Inquire として提供されます。

Methods

Included Modules

gtdata_types gt_map an_generic dc_trace gtdata_generic

Public Instance methods

Subroutine :
var :type(GT_VARIABLE), intent(in)
growable :logical, intent(out), optional
: 変数が次元変数である場合、 自動拡張可能か否かを返します。 次元変数でない場合は不定となります。
rank :integer, intent(out), optional
: コンパクト(縮退)次元を数えない、 次元の数
alldims :integer, intent(out), optional
: 縮退次元を含む全次元数。 dimord には基本的にこちらを 使います。
allcount :integer, intent(out), optional
: 変数が次元変数である場合、 総数を返します。 エラーの場合はゼロを返します。
size :integer, intent(out), optional
: 変数の入出力領域の大きさ。 (変数が依存する各次元の長 [格子点数]の積)
xtype :character(len=*), intent(out), optional
: 外部型の名前
name :character(len=*), intent(out), optional
: name は変数名の最小の単位を返します。 ファイル名を含まないため プログラム内での一意性は 保証されません。
url :character(len=*), intent(out), optional
: url はファイル名のついた変数名 を返します。 プログラム内で一意です。

変数に関する問い合わせ

変数 var に関する問い合わせを行います。

返り値となる引数の文字型の実引数の長さが足りないと、 結果が損なわれます。引数の文字列の長さとして dc_types#STRING を用いることを推奨します。

Inquire は複数のサブルーチンの総称名であり、 問い合わせ方法は複数用意されています。 下記のサブルーチンも参照してください。

他にも変数に関する問い合わせのための手続きとして Get_Slice, Dimname_to_Dimord があります。

[Source]

subroutine GTVarInquire(var, growable, rank, alldims, allcount, size, xtype, name, url)
  !
  !== 変数に関する問い合わせ
  !
  ! 変数 *var* に関する問い合わせを行います。
  !
  ! 返り値となる引数の文字型の実引数の長さが足りないと、
  ! 結果が損なわれます。引数の文字列の長さとして dc_types#STRING
  ! を用いることを推奨します。
  !
  ! *Inquire* は複数のサブルーチンの総称名であり、
  ! 問い合わせ方法は複数用意されています。
  ! 下記のサブルーチンも参照してください。
  !
  ! 他にも変数に関する問い合わせのための手続きとして
  ! Get_Slice, Dimname_to_Dimord があります。
  !
  !
  !
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: inquire, an_variable
  use dc_trace, only: beginsub, endsub, DbgMessage
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len=*), intent(out), optional:: xtype
                                        ! 外部型の名前
  character(len=*), intent(out), optional:: name
                                        ! name は変数名の最小の単位を返します。
                                        ! ファイル名を含まないため
                                        ! プログラム内での一意性は
                                        ! 保証されません。
                                        ! 
  character(len=*), intent(out), optional:: url
                                        ! url はファイル名のついた変数名
                                        ! を返します。
                                        ! プログラム内で一意です。
                                        ! 
  integer, intent(out), optional:: rank
                                        ! コンパクト(縮退)次元を数えない、
                                        ! 次元の数
                                        ! 
  integer, intent(out), optional:: alldims
                                        ! 縮退次元を含む全次元数。
                                        ! dimord には基本的にこちらを
                                        ! 使います。
                                        ! 
  integer, intent(out), optional:: allcount
                                        ! 変数が次元変数である場合、
                                        ! 総数を返します。
                                        ! エラーの場合はゼロを返します。
                                        ! 
  integer, intent(out), optional:: size
                                        ! 変数の入出力領域の大きさ。
                                        ! (変数が依存する各次元の長
                                        ! [格子点数]の積)
                                        ! 
  logical, intent(out), optional:: growable
                                        ! 変数が次元変数である場合、
                                        ! 自動拡張可能か否かを返します。
                                        ! 次元変数でない場合は不定となります。
                                        ! 
  integer:: class, cid
continue
  call beginsub('gtvarinquire', 'var.mapid=%d', i=(/var%mapid/))
  call var_class(var, class, cid)
  select case(class)
  case(vtb_class_netcdf)
    if (present(xtype) .or. present(name) .or. present(url)) then
      call inquire(an_variable(cid), xtype=xtype, name=name, url=url)
      if (present(xtype)) call DbgMessage('xtype=%c', c1=trim(xtype))
      if (present(name)) call DbgMessage('name=%c', c1=trim(name))
      if (present(url)) call DbgMessage('url=%c', c1=trim(url))
    endif
    if (present(growable)) then
      call inquire(an_variable(cid), growable=growable)
      call DbgMessage('growable=%y', L=(/growable/))
    endif
  case(vtb_class_memory)
    call DbgMessage('vtb_class_memory not implemented: skipped')
  end select
  if (present(alldims)) alldims = internal_get_alldims(var)
  if (present(allcount)) allcount = internal_get_allcount(var)
  if (present(size)) size = internal_get_size(var)
  if (present(rank)) rank = internal_get_rank(var)
  call endsub('gtvarinquire')
  return
contains

  integer function internal_get_alldims(var) result(result)
    use gt_map, only: map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    call map_lookup(var, ndims=result)
    call DbgMessage('alldims=%d', i=(/result/))
  end function internal_get_alldims

  integer function internal_get_allcount(var) result(result)
    use gt_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd
    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_allcount: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = product(map(1:nd)%allcount)
    call DbgMessage('internal_get_allcount: %d map.size=%d', i=(/result, nd/))
    deallocate(map)
  end function internal_get_allcount

  integer function internal_get_size(var) result(result)
    use gt_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd
    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_size: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = product(map(1:nd)%count)
    call DbgMessage('internal_get_size: %d map.size=%d', i=(/result, nd/))
    deallocate(map)
  end function internal_get_size

  integer function internal_get_rank(var) result(result)
    use gt_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd

    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_rank: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = count(map(1:nd)%count > 1)
    call DbgMessage('internal_get_rank: %d', i=(/result/))
    deallocate(map)
  end function internal_get_rank

end subroutine GTVarInquire
Subroutine :
var :type(GT_VARIABLE), intent(in)
allcount(:) :integer, intent(out)
: alldims 個必要

変数の依存する次元 (複数) の総数の問い合わせ

変数 var が依存する各次元の総数を返します。 allcount の配列のサイズは依存する次元の数だけ必要です。 依存する次元の数は上記の Inquirealldims で調べることが できます。

[Source]

subroutine GTVarInquire2(var, allcount)
  !
  !== 変数の依存する次元 (複数) の総数の問い合わせ
  !
  ! 変数 *var* が依存する各次元の総数を返します。
  ! *allcount* の配列のサイズは依存する次元の数だけ必要です。
  ! 依存する次元の数は上記の *Inquire* の *alldims* で調べることが
  ! できます。
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: inquire, open, close
  use dc_trace, only: beginsub, endsub
  type(GT_VARIABLE), intent(in):: var
  integer, intent(out):: allcount(:) ! alldims 個必要
  integer:: i, n
  type(GT_VARIABLE):: v
  call beginsub('gtvarinquire2')
  call inquire(var, alldims=n)
  do, i = 1, n
    call Open(v, var, i, count_compact=.true.)
    call inquire(var, allcount=allcount(i))
    call Close(v)
  enddo
  call endsub('gtvarinquire2')
end subroutine
Subroutine :
var :type(GT_VARIABLE), intent(in)
attrname :character(len=*), intent(in)
xtype :character(len=*), intent(out), optional

変数の属性の型の問い合わせ

変数 var の属性 attrname の値の型を xtype に返します。

[Source]

subroutine GTVarInquireA(var, attrname, xtype)
  !
  !== 変数の属性の型の問い合わせ
  !
  ! 変数 *var* の属性 *attrname* の値の型を *xtype* に返します。
  !
  !
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use dc_trace, only: beginsub, endsub
  use an_generic, only: inquire, an_variable
  type(GT_VARIABLE), intent(in):: var
  character(len=*), intent(in):: attrname
  character(len=*), intent(out), optional:: xtype
  integer:: class, cid
  character(len = *), parameter:: subnam = "gtvarinquireA"
continue
  call beginsub(subnam, "%c", c1=trim(attrname))
  call var_class(var, class, cid)
  select case(class)
  case(vtb_class_netcdf)
    call inquire(an_variable(cid), attrname=attrname, xtype=xtype)
  end select
  call endsub(subnam)
end subroutine GTVarInquireA
Subroutine :
var :type(GT_VARIABLE), intent(in)
dimord :integer, intent(in)
url :character(len=*), intent(out), optional
allcount :integer, intent(out), optional

変数の次元に関する問い合わせ

変数 var の次元順序番号 dimord に対応する次元の URL url と総数 allcout を返します。

[Source]

subroutine GTVarInquireD(var, dimord, url, allcount)
  !
  !== 変数の次元に関する問い合わせ
  !
  ! 変数 *var* の次元順序番号 *dimord* に対応する次元の
  ! URL *url* と総数 *allcout* を返します。
  ! 
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: open, close, inquire
  use dc_trace, only: beginsub, endsub
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, intent(in):: dimord
  character(len=*), intent(out), optional:: url
  integer, intent(out), optional:: allcount
  type(GT_VARIABLE):: dimvar
  character(len = *), parameter:: subnam = "gtvarinquireD"
continue
  call beginsub(subnam, "%d", i=(/dimord/))
  call open(dimvar, source_var=var, dimord=dimord)
  if (present(url)) call inquire(dimvar, url=url)
  if (present(allcount)) call inquire(dimvar, allcount=allcount)
  call close(dimvar)
  call endsub(subnam)
end subroutine GTVarInquireD

Private Instance methods

Function :
result :integer
var :type(GT_VARIABLE), intent(in)

[Source]

  integer function internal_get_allcount(var) result(result)
    use gt_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd
    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_allcount: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = product(map(1:nd)%allcount)
    call DbgMessage('internal_get_allcount: %d map.size=%d', i=(/result, nd/))
    deallocate(map)
  end function internal_get_allcount
Function :
result :integer
var :type(GT_VARIABLE), intent(in)

[Source]

  integer function internal_get_alldims(var) result(result)
    use gt_map, only: map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    call map_lookup(var, ndims=result)
    call DbgMessage('alldims=%d', i=(/result/))
  end function internal_get_alldims
Function :
result :integer
var :type(GT_VARIABLE), intent(in)

[Source]

  integer function internal_get_rank(var) result(result)
    use gt_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd

    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_rank: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = count(map(1:nd)%count > 1)
    call DbgMessage('internal_get_rank: %d', i=(/result/))
    deallocate(map)
  end function internal_get_rank
Function :
result :integer
var :type(GT_VARIABLE), intent(in)

[Source]

  integer function internal_get_size(var) result(result)
    use gt_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd
    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_size: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = product(map(1:nd)%count)
    call DbgMessage('internal_get_size: %d map.size=%d', i=(/result, nd/))
    deallocate(map)
  end function internal_get_size

[Validate]