! gtdata_variable.f90 - gtool 変数の手続総称宣言 ! Copyright (C) GFD Dennou Club, 2000. All rights reserved. module gtdata_generic implicit none ! ! 基本開閉動作 ! interface open ! ! open(var, url, [writable], [err]) は url で識別される ! 変数を開き var に格納する。writable を真に指定すると ! 書き込み可で開こうとする。デフォルトは writable=.FALSE. である。 ! エラーが発生した場合は err が真となる。err を与えなければプログラムは停止する。 ! subroutine GTVarOpen(var, url, writable, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(out):: var character(*), intent(in):: url logical, intent(in), optional:: writable logical, intent(out), optional:: err end subroutine ! ! 既に開かれた変数 source_var の ord 番目の次元にあたる変数を ! 開き var に格納する。順序 ord は現在の入出力範囲が ! 幅1になっている (コンパクト化している)を飛ばした ! 順序であるが、count_compact に真を指定すると ! すべての次元のなかの順序になる。 ! ! ord == 0 の場合は変数自体を再度開く。これは参照カウンタを ! 増加させる手段である。 ! subroutine GTVarOpenByDimOrd(var, source_var, dimord, & count_compact, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(out):: var type(GT_VARIABLE), intent(in):: source_var integer, intent(in):: dimord logical, intent(in), optional:: count_compact logical, intent(out), optional:: err end subroutine end interface interface create ! ! 従属変数 create ! ! create(var, url, [dims], [xtype], [overwrite], [err]) は ! 場所 url に次元 dims を持った変数を作成し、それを開いた ! ものを var に格納する。型 xtype を省略すると "float" と ! みなされる。既存変数があるとき失敗するが ! overwrite が真であれば続行する。 ! dims の省略は 0 次元変数の設定を意味する。 ! subroutine GTVarCreate(var, url, dims, xtype, long_name, overwrite, err) use gtdata_types, only: gt_variable type(gt_variable), intent(inout):: var character(len = *), intent(in):: url type(gt_variable), intent(in), optional:: dims(:) character(len = *), intent(in), optional:: xtype character(len = *), intent(in), optional:: long_name logical, intent(in), optional:: overwrite logical, intent(out), optional:: err end subroutine ! ! 独立変数 create ! ! 長さ length の自分自身を次元とする変数を作成する。 ! 長さ length = 0 の変数は可変長である。 ! subroutine GTVarCreateD(var, url, length, xtype, long_name, overwrite, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: url integer, intent(in):: length character(len = *), intent(in), optional:: xtype character(len = *), intent(in), optional:: long_name logical, intent(in), optional:: overwrite logical, intent(out), optional:: err end subroutine end interface interface close subroutine GTVarClose(var, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var logical, intent(out), optional:: err end subroutine end interface ! ! --- 属性関係 --- ! interface attr_rewind subroutine GTVarAttrRewind(var) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var end subroutine end interface interface attr_next subroutine GTVarAttrNext(var, name, end) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(*), intent(out):: name logical, intent(out), optional:: end end subroutine end interface ! 論理型読み取りは関数インターフェイスも提供 interface attr_true logical function GTVarAttrTrue(var, name, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name logical, intent(in), optional:: default end function end interface interface get_attr ! 文字列として読み取る場合は元の長さは正確に受け取られる。 ! 属性が存在しない場合 default 値を使う。 subroutine GTVarGetAttrSC(var, name, value, default) use dc_string, only: VSTRING use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name type(VSTRING), intent(out):: value character(len = *), intent(in), optional:: default end subroutine ! character 型で受け取る場合は通常の文字型代入と同様、 ! 受け側変数の長さに合わせて切り捨て・空白埋めを行う。 ! 属性が存在しない場合 default 値を使う。 subroutine GTVarGetAttrCC(var, name, value, default) use dc_string, only: VSTRING use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name character(len = *), intent(out):: value character(len = *), intent(in), optional:: default end subroutine ! スカラで受け取るのが一番簡単。解釈可能な値がとられ、残りは捨てられる。 subroutine GTVarGetAttrR(var, name, value, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name real, intent(out):: value real, intent(in), optional:: default end subroutine subroutine GTVarGetAttrD(var, name, value, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name double precision, intent(out):: value double precision, intent(in), optional:: default end subroutine subroutine GTVarGetAttrI(var, name, value, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name integer, intent(out):: value integer, intent(in), optional:: default end subroutine ! ポインタ配列を使って受け取る場合は解釈可能な数だけ実体が割り付けられる。 subroutine GTVarGetAttrRP(var, name, value) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name real, pointer:: value(:) end subroutine subroutine GTVarGetAttrDP(var, name, value) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name double precision, pointer:: value(:) end subroutine subroutine GTVarGetAttrIP(var, name, value) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name integer, pointer:: value(:) end subroutine ! integer 配列, real 配列として受け取る ! 場合は属性長があまっている場合には切り捨てられ、 ! 属性長が足りない場合は default 値 (ポインタと違い必須) を埋める。 subroutine GTVarGetAttrRA(var, name, value, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name real, intent(out):: value(:) real, intent(in):: default end subroutine subroutine GTVarGetAttrDA(var, name, value, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name double precision, intent(out):: value(:) double precision, intent(in):: default end subroutine subroutine GTVarGetAttrIA(var, name, value, default) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name integer, intent(out):: value(:) integer, intent(in):: default end subroutine end interface interface put_attr subroutine GTVarPutAttrString(var, name, value, err) use dc_string, only: VSTRING use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name type(VSTRING), intent(in):: value logical, intent(out), optional:: err end subroutine subroutine GTVarPutAttrChar(var, name, value, xtype, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name character(len = *), intent(in):: value character(len = *), intent(in), optional:: xtype logical, intent(out), optional:: err end subroutine subroutine GTVarPutAttrReal(var, name, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name real, intent(in):: value(:) real, intent(out), optional:: err end subroutine subroutine GTVarPutAttrDouble(var, name, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name double precision, intent(in):: value(:) real, intent(out), optional:: err end subroutine subroutine GTVarPutAttrInt(var, name, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name integer, intent(in):: value(:) real, intent(out), optional:: err end subroutine subroutine GTVarPutAttrLogical(var, name, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name logical, intent(in):: value real, intent(out), optional:: err end subroutine end interface interface del_attr subroutine GTVarDelAttr(var, name, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name logical, intent(out), optional:: err end subroutine end interface interface copy_attr subroutine GTVarCopyAttr(to, attrname, from, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: to character(len = *), intent(in):: attrname type(GT_VARIABLE), intent(in):: from logical, intent(out), optional:: err end subroutine subroutine gtvarcopyattrall(to, from, err) use gtdata_types, only: gt_variable type(gt_variable), intent(inout):: to type(gt_variable), intent(inout):: from logical, intent(out):: err end subroutine end interface ! ! --- 次元関係 --- ! ! 現在の入出力範囲の大きさは inquire(var, size=) で取得できる interface slice ! おまかせ指示 ! compatible を指定するとまったく同じに指定 subroutine GTVarSliceAuto(var, compatible) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var type(GT_VARIABLE), intent(in), optional:: compatible end subroutine ! もじれつによるしじ subroutine GTVarSliceC(var, slicespec, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: slicespec logical, intent(out):: err end subroutine ! 次元を指定した指示 subroutine GTVarSlice(var, dimord, start, count, stride) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var integer, intent(in):: dimord integer, intent(in), optional:: start integer, intent(in), optional:: count integer, intent(in), optional:: stride end subroutine end interface interface get_slice ! 次元順番を指定して取得 subroutine GTVarGetSlice(var, dimord, start, count, stride, count_compact) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var integer, intent(in):: dimord integer, intent(out), optional:: start integer, intent(out), optional:: count integer, intent(out), optional:: stride logical, intent(in), optional:: count_compact end subroutine ! 全次元について一括取得 ! あらかじめ inquire(var, alldims) して配列を確保する。 subroutine GTVarGetSliceAll(var, start, count, stride) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var integer, intent(out), optional:: start(:), count(:), stride(:) end subroutine end interface interface dimname_to_dimord integer function gtdim_name2ord(var, name) use gtdata_types, only: gt_variable type(gt_variable), intent(in):: var character(len = *), intent(in):: name end function end interface ! limit: 空間変換器機能のセットアップ ! interface limit subroutine GTVarLimit(var, string, err) use gtdata_types, only: gt_variable type(gt_variable), intent(inout) :: var character(len = *), intent(in) :: string logical, intent(out), optional :: err end subroutine subroutine GTVarLimit_iiii(var, dimord, start, count, stride, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var integer, intent(in) :: dimord integer, intent(in) , optional :: start, count, stride logical, intent(out), optional :: err end subroutine end interface interface transform subroutine GTVarXformBinary(var1, var2, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var1, var2 logical, intent(out), optional:: err end subroutine end interface ! 明示的空間変換機能 ! 変数ハンドル var の dimord 番目の位置に次元 ! dimvar を追加する。dimord 番目以降の次元は一つ後ろにずれる。 ! もし dimord が var の有効次元数より大きければ (有効次元数 + 1) ! が与えられたものとみなされる。 interface add_dim subroutine gtvaradddim(var, dimord, dimvar, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var type(GT_VARIABLE), intent(in):: dimvar integer, intent(in):: dimord logical, intent(out):: err end subroutine end interface ! 変数ハンドルから次元を「除去」する。実際には、 ! 次元対応表の順位を下げ有効次元数をデクリメントするだけなので、 ! 入出力に支障はない。 interface del_dim subroutine gtvardeldim(var, dimord, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var integer, intent(in):: dimord logical, intent(out):: err end subroutine end interface ! 次元対応表の順位の交換 interface exch_dim subroutine gtvarexchdim(var, dimord1, dimord2, count_compact, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var integer, intent(in):: dimord1, dimord2 logical, intent(in), optional:: count_compact logical, intent(out):: err end subroutine end interface ! ! --- 問い合わせ --- ! interface inquire subroutine GTVarInquire(var, growable, & & rank, alldims, allcount, size, & & xtype, name, url) use gtdata_types, only: gt_variable type(gt_variable), intent(in):: var ! 外部型の名前 character(len=*), intent(out), optional:: xtype ! name は変数名の最小の単位を返す。 ! ファイル名を含まないためプログラム内での一意性は保証されない。 character(len=*), intent(out), optional:: name ! url はファイル名のついた変数名を返す。プログラム内で ! 一意である。 character(len=*), intent(out), optional:: url ! コンパクト(縮退)次元を数えない, 次元の数 integer, intent(out), optional:: rank ! 縮退次元を含む全次元数。dimord には基本的にこちらを使う integer, intent(out), optional:: alldims ! 変数が次元変数である場合、総数を返す。エラーはゼロ。 integer, intent(out), optional:: allcount ! 変数の入出力領域の大きさ。 integer, intent(out), optional:: size ! 変数が次元変数である場合、自動拡張可能か否かを返す。 ! そうでない場合は不定。 logical, intent(out), optional:: growable end subroutine subroutine GTVarInquire2(var, allcount) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var ! alldims 個必要 integer, intent(out):: allcount(:) end subroutine subroutine GTVarInquireD(var, dimord, url, allcount) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var integer, intent(in):: dimord character(len=*), intent(out), optional:: url integer, intent(out), optional:: allcount end subroutine subroutine GTVarInquireA(var, attrname, xtype) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in):: var character(len=*), intent(in):: attrname character(len=*), intent(out), optional:: xtype end subroutine end interface ! 総なめ用イテレータ interface slice_next subroutine GTVarSliceNext(var, dimord, err, stat) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(in out):: var integer, intent(in), optional:: dimord logical, intent(out), optional:: err integer, intent(out), optional:: stat end subroutine end interface ! 同値判定 interface operator(.equivalent.) logical function gtvarequivalent(var1, var2) use gtdata_types, only: gt_variable type(gt_variable), intent(in):: var1, var2 end function end interface ! ! === 入出力 === ! ! --- 入力 --- ! ! get(var, value, nvalue, [err]) ! 1次元配列に現在の入出力範囲を取得する。 ! nvalue は利用者が配列長を格納しなければならない。 ! 個別名 GTVarGetReal を用いると多次元配列に入力 ! することもできるが、入出力範囲との関係に注意が必要。 ! ! get(var, value, [err]) は 1〜3 次元のポインタをとる。 ! 入出力範囲をポインタ次元数に限定し、配列を確保し、 ! 値を入れて返す。通常はこれを用いることになろう。 ! interface get subroutine GTVarGetReal(var, value, nvalue, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, intent(out):: value(*) integer, intent(in):: nvalue logical, intent(out), optional:: err end subroutine subroutine GTVarGetReal1(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, pointer:: value(:) logical, intent(out), optional:: err end subroutine subroutine GTVarGetReal2(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, pointer:: value(:, :) logical, intent(out), optional:: err end subroutine subroutine GTVarGetReal3(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, pointer:: value(:, :, :) logical, intent(out), optional:: err end subroutine subroutine GTVarGetDouble(var, value, nvalue, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, intent(out):: value(*) integer, intent(in):: nvalue logical, intent(out), optional:: err end subroutine subroutine GTVarGetDouble1(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, pointer:: value(:) logical, intent(out), optional:: err end subroutine subroutine GTVarGetDouble2(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, pointer:: value(:, :) logical, intent(out), optional:: err end subroutine subroutine GTVarGetDouble3(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, pointer:: value(:, :, :) logical, intent(out), optional:: err end subroutine end interface ! ! --- 印字 --- ! ! 印字というのは変数にしてみれば入力だしファイルにしてみれば出力だ。 ! だから put と get を兼営しているようなものでまことにあやしいのだが、 ! いちおう dc_string の手続名を継承して put_line にしておく。 interface put_line subroutine GTVarPutLine(var, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var logical, intent(out), optional:: err end subroutine end interface ! ! --- 出力 --- ! interface put subroutine GTVarPutReal(var, value, nvalue, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, intent(in):: value(*) integer, intent(in):: nvalue logical, intent(out), optional:: err end subroutine subroutine GTVarPutReal1(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, intent(in):: value(:) logical, intent(out), optional:: err end subroutine subroutine GTVarPutReal2(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, intent(in):: value(:, :) logical, intent(out), optional:: err end subroutine subroutine GTVarPutReal3(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var real, intent(in):: value(:, :, :) logical, intent(out), optional:: err end subroutine subroutine GTVarPutDouble(var, value, nvalue, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, intent(in):: value(*) integer, intent(in):: nvalue logical, intent(out), optional:: err end subroutine subroutine GTVarPutDouble1(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, intent(in):: value(:) logical, intent(out), optional:: err end subroutine subroutine GTVarPutDouble2(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, intent(in):: value(:, :) logical, intent(out), optional:: err end subroutine subroutine GTVarPutDouble3(var, value, err) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout):: var double precision, intent(in):: value(:, :, :) logical, intent(out), optional:: err end subroutine end interface ! ! === 変数とファイルの関係 === ! interface GTVarSearch subroutine GTVarSearchInit(urlBase) character(len = *), intent(in):: urlBase end subroutine subroutine GTVarSearchNext(url, end) character(len = *), intent(out):: url logical, intent(out):: end end subroutine end interface ! ! === 安全のための脱出口 === ! ! SysDepAbort が呼び出すので、StoreError を呼んではならない ! interface subroutine GTVarSync(var, stat) use gtdata_types, only: GT_VARIABLE type(GT_VARIABLE), intent(inout), optional:: var integer, intent(out), optional:: stat end subroutine end interface ! ! === ユーティリティ === ! ! gtdata 層だけで書かれたライブラリ。 ! Create(var, url, copyfrom, [copyvalue], [overwrite], [err]) ! は変数 copyfrom と同じ次元、属性を持った変数を作成する。 ! 必要ならば次元変数も複製される。 ! copyvalue を真に指定すると値も複製される。 ! interface Create subroutine GTVarCreateCopyC(var, url, copyfrom, copyvalue, & & overwrite, err) use gtdata_types, only: GT_VARIABLE implicit none type(GT_VARIABLE), intent(out):: var character(len = *), intent(in):: url type(GT_VARIABLE), intent(inout):: copyfrom logical, intent(in), optional:: copyvalue logical, intent(in), optional:: overwrite logical, intent(out), optional:: err end subroutine end interface interface GTVarDel subroutine GTVarDel1(varname, err) character(len = *), intent(in):: varname logical, intent(out):: err end subroutine end interface ! ! --- 構造体関係 --- ! interface add_member subroutine GTVarAddMember(var, url, link_name) use gtdata_types, only: GT_VARIABLE use dc_string, only: VSTRING type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: url character(len = *), intent(in), optional:: link_name end subroutine end interface ! 一意な変数名の自動作成 interface subroutine GTDataTmpNam(file, base, result) character(len = *), intent(in):: file character(len = *), intent(in):: base character(len = *), intent(out):: result end subroutine end interface end module