! gtdata_variable.f90 - gtool 変数の手続総称宣言
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved.

module gtdata_generic

    !
    ! 基本開閉動作
    !

    interface open

        ! 
        ! open(var, url, [writable], [err]) は url で識別される
        ! 変数を開き var に格納する。writable を真に指定すると
        ! 書き込み可で開こうとする。デフォルトは writable=.FALSE. である。
        ! エラーが発生した場合は err が真となる。err を与えなければプログラムは停止する。
        !
        subroutine GTVarOpen(var, url, writable, err)
            use dc_string, only: VSTRING    
            use gtdata_types, only: GT_VARIABLE
            type(GT_VARIABLE), intent(inout):: var
            type(VSTRING), intent(in):: url
            logical, intent(in), optional:: writable
            logical, intent(out), optional:: err
        end subroutine
        
        !
        ! open(dimvar, var, dimord, [count_compact], [err]) は
        ! 既に開かれた変数 var の ord 番目の次元にあたる変数を
        ! 開き dimvar に格納する。順序 ord は現在の入出力範囲が
        ! 幅１になっている (コンパクト化している）を飛ばした
        ! 順序であるが、count_compact に真を指定すると
        ! すべての次元のなかの順序になる。
        !
        ! ord == 0 の場合は変数自体を再度開く。これは参照カウンタを
        ! 増加させる手段である。
        !
        subroutine GTVarOpenByDimOrd(dimvar, var, dimord, &
            count_compact, err)
            use gtdata_types, only: GT_VARIABLE
            type(GT_VARIABLE), intent(inout):: dimvar
            type(GT_VARIABLE), intent(in):: 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
            use dc_string, only: VSTRING    
            type(GT_VARIABLE), intent(inout):: var
            type(VSTRING), 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 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 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, stat, default)
            use gtdata_types, only: GT_VARIABLE
            type(GT_VARIABLE), intent(in):: var
            character(len = *), intent(in):: name
            real, intent(out):: value(:)
            integer, intent(out):: stat
            real, intent(in), optional:: default
        end subroutine

        subroutine GTVarGetAttrIA(var, name, value, stat, default)
            use gtdata_types, only: GT_VARIABLE
            type(GT_VARIABLE), intent(in):: var
            character(len = *), intent(in):: name
            integer, intent(out):: value(:)
            integer, intent(out):: stat
            integer, intent(in), optional:: 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(in):: 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(in):: 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(in):: 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(in):: 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(in):: 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(in):: 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(in):: 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(in):: to
            character(len = *), intent(in):: attrname
            type(GT_VARIABLE), intent(in):: from
            logical, intent(out), optional:: 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 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)
            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
        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):: start(:), count(:), stride(:)
        end subroutine

    end interface

    interface inquire
        subroutine GTVarInquireV(var, xtype, ndims, alldims, name, url, &
            & allcount, size)
            use gtdata_types, only: GT_VARIABLE
            use dc_string, only: VSTRING
            type(GT_VARIABLE), intent(in):: var
            ! 外部型
            type(VSTRING), intent(out), optional:: xtype
            ! コンパクト(縮退)次元を数えない
            integer, intent(out), optional:: ndims
            ! 縮退次元を含む全次元数。dimord のループにはこちらを使う
            integer, intent(out), optional:: alldims
            ! name(var) は変数名の最小の単位を返す。
            ! ファイル名を含まないためプログラム内での一意性は保証されない。
            type(VSTRING), intent(out), optional:: name
            ! url(var) はファイル名のついた変数名を返す。プログラム内で
            ! 一意である。
            type(VSTRING), intent(out), optional:: url
            ! 変数が次元変数である場合だけ、総数を返す。エラーはゼロ。
            integer, intent(out), optional:: allcount
            ! 入出力領域の大きさ
            integer, intent(out), optional:: size
        end subroutine

        subroutine GTVarInquire(var, xtype, name, url)
            use gtdata_types, only: GT_VARIABLE
            type(GT_VARIABLE), intent(in):: var
            character(len=*), intent(out), optional:: xtype
            character(len=*), intent(out), optional:: name
            character(len=*), intent(out), optional:: url
        end subroutine

        subroutine GTVarInquireAV(var, attrname, xtype)
            use gtdata_types, only: GT_VARIABLE
            use dc_string, only: VSTRING
            type(GT_VARIABLE), intent(in):: var
            character(len=*), intent(in):: attrname
            type(VSTRING), intent(out), optional:: xtype
        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

    !
    ! === 入出力 ===
    !
    ! --- 入力 ---
    !
    ! 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)
            use dc_string, only: VSTRING
            type(VSTRING), intent(in):: urlBase
        end subroutine

        subroutine GTVarSearchNext(url, end)
            use dc_string, only: VSTRING
            type(VSTRING), 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 GTVarCreateCopy(var, url, copyfrom, copyvalue, &
            & overwrite, err)
            use gtdata_types, only: GT_VARIABLE
            use dc_string, only: VSTRING
            type(GT_VARIABLE), intent(out):: var
            type(VSTRING), 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 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
            type(VSTRING), intent(in):: url
            character(len = *), intent(in), optional:: link_name
        end subroutine
    end interface

    ! 一意な変数名の自動作成
    interface 
        type(VSTRING) function GTDataTmpNam(file, base)
            use dc_string, only: VSTRING
            type(VSTRING), intent(in), optional:: file, base
        end function
    end interface


end module
