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-20070615 $ |
Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
License: | See COPYRIGHT |
以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Inquire として提供されます。
Subroutine : | |||
var : | type(GT_VARIABLE), intent(in) | ||
growable : | logical, intent(out), optional
| ||
rank : | integer, intent(out), optional
| ||
alldims : | integer, intent(out), optional
| ||
allcount : | integer, intent(out), optional
| ||
size : | integer, intent(out), optional
| ||
xtype : | character(len=*), intent(out), optional
| ||
name : | character(len=*), intent(out), optional
| ||
url : | character(len=*), intent(out), optional
|
変数 var に関する問い合わせを行います。
返り値となる引数の文字型の実引数の長さが足りないと、 結果が損なわれます。引数の文字列の長さとして dc_types#STRING を用いることを推奨します。
Inquire は複数のサブルーチンの総称名であり、 問い合わせ方法は複数用意されています。 下記のサブルーチンも参照してください。
他にも変数に関する問い合わせのための手続きとして Get_Slice, Dimname_to_Dimord があります。
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)
|
変数 var が依存する各次元の総数を返します。 allcount の配列のサイズは依存する次元の数だけ必要です。 依存する次元の数は上記の Inquire の alldims で調べることが できます。
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 に返します。
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 を返します。
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
Function : | |
result : | integer |
var : | type(GT_VARIABLE), intent(in) |
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) |
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) |
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) |
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