gtool4/Fortran 90 チュートリアル / ツールのプログラム解説

入出力編

2001年10月10日 豊田英司


gtool 変数

入出力では type(gt_variable) という型の (Fortran の) 変数を使います。これが gtool 変数を表すものです。

まぎらわしいのですが、以下で変数というとき Fortran の変数でなく gtool 変数のことを指します。

gtool 変数は任意次元の配列ですが、以下で説明するアクセス方法をみてもわかるとおり、 type(gt_variable) は Fortran の装置番号や C の FILE * 型値のようなものだと考えたほうが近いでしょう。これから紹介するサブルーチン (Open, Close, Get, Put, ...) は Fortran の入出力文 (OPEN, CLOSE, READ, WRITE, ...) や C の入出力関数 (fopen, fclose, fwrite, fread, ...) に対応させて理解してください。

変数全体読み取り: gtprint

gtprint コマンドの機能のひとつは(名前で)与えられた gtool 変数について、その値をすべて印字することです。変数全体が主記憶におさまるという前提のもとでは、その操作は例4(a)のようにして実現できます。

! --- 例4(a) ---
use gtool
implicit none

character(string):: varname
type(gt_variable):: var
integer:: i, size
real, allocatable:: buffer(:)

call Open(var, varname)
call Inquire(var, size=size)
allocate(buffer(size))
call Get(var, buffer, size)
do, i = 1, size
    print *, buffer(i)
enddo 
call Close(var)

ここでは、変数 (type(gt_variable) 型変数) を Open で初期化し、Inquire で入出力に要する配列の大きさを調べ、Get で読み取り、Close で変数の利用を終了します。Get は変数全体を読み取ります。読み取り範囲を限定する方法については後に述べます。反対に書き込みは Put です。こちらも変数全体を書き込みます。

ただし実際には、配列の割付・開放、印字を行う put_line サブルーチンが提供されていて、例4(b) のようなコードになっています。

! --- 例4(b) ---
use gtool
implicit none

character(string):: varname
type(gt_variable):: var

call Open(var, varname)
call put_line(var)
call Close(var)

どうして Get のかわりに put_line というものが作られているかというと、変数全体が主記憶におさまらない場合の対処ができるようにするためです。

スライス

全体が主記憶に納まらない大きさの変数を印字するにはどうしたらよいでしょうか。変数の全部を読み出すかわりに一部を読み出すことにして、それを繰り返せばよいですね。そのような目的のためにスライスという機構が提供されています。

Slice サブルーチンを呼び出すと、指定した次元について範囲を指定することができます。このあと Slice_Next サブルーチンを stat 引数が定数 dc_noerr でなくなるまで呼び出すと、変数全体を走査できます。このようなループの例を例5に示します。

! --- 例5 ---
use gtool
implicit none

type(gt_variable):: var
integer:: stat

call Open(var, "filename?varname")
call Slice(var, dimord=1, start=1, count=1)
do
    call Slice_Next(var, stat=stat)
    if (stat /= dc_noerr) exit
    call get(var, 中略)
    中略
enddo
call Close(var)

変数複写: gtcopy

gtcopy コマンドがやってくれる変数の複写という作業は入力変数と「同じ構造」の出力変数を作成する作業です。「同じ構造」というのがどういうことかが問題ですが、gtool4 では各次元について

という条件を採用することにしました。必須条件と考慮条件がありますが、出力変数を新規ファイルに作成する場合は両者ともに満たされるように作成されるので、問題はありません。相違は、既存のファイルの中から次元変数を探す場合で、考慮条件が満たされない次元変数でも選択したほうがよい結果が得られると考えられるからです。

このように「同じ構造の変数の作成」は複雑な手順を伴いますが、この作業はすべて gt_variable 型を第二引数とする Create サブルーチンがやってくれます。じつは、この場合 Create がついでに変数複写もやってくれるので、 gtcopy コマンドの主要部は例6のようになります。

! --- 例6 ---
subroutine do_copy(source, dest)
    character(len=*), intent(in):: source
    character(len=*), intent(in):: dest
    type(GT_VARIABLE):: vSource
    type(GT_VARIABLE):: vDest
    call Open(vSource, url=source)
    call Create(vDest, url=dest, copyfrom=vSource, &
        & copyvalue=.TRUE.)
    call Close(vSource)
    call Close(vDest)
end subroutine

変数値の読み書き: gtunary

上記 gtcopy の例において、もし Create に変数値複写機能がなければ、 例7 のように Create の直後に Get と Put を入れて変数を複写することになるでしょう。

! --- 例7 ---
integer:: bufsiz
real, allocatable:: buffer(:)
logical:: err

call Open(vSource, url=source)
call Create(vDest, url=dest, copyfrom=vSource)
call Inquire(vSource, size=bufsiz)
allocate(buffer(bufsiz))
call Get(vSource, buffer, isiz, err)
call Put(vDest, buffer, isiz, err)
call Close(vSource)
call Close(vDest)

しかしながら、この実装は bufsiz が十分大きすぎて ALLOCATE が失敗する場合には使えません。そのような場合にも対応するためには、スライス機能を用います。

! --- 例8 ---
integer:: stat

call Open(vSource, url=source)
call Create(vDest, url=dest, copyfrom=vSource)
call Slice(vSource)
call Slice(vDest, vSource)
call Inquire(vSource, size=bufsiz)
allocate(buffer(bufsiz))
do
    call Get(vSource, buffer, isiz, err)
    call Put(vDest, buffer, isiz, err)
    call Slice_Next(vSource, stat=stat)
    if (stat /= 0) break
    call Slice_Next(vDest, stat=stat)
    if (stat /= 0) break
enddo
call Close(vSource)
call Close(vDest)

引数1つの Slice は適切な大きさに入出力範囲を制限します。つぎの Slice(vDest, vSource) は vDest の入出力範囲を vSource と同じにします。

単項演算子コマンド gtunary では上のようなループを用いて読み書きを行っています。

次元を減らす操作: gtavg

変数に対する操作は必ずしも次元構成を保ったものであるとは限りません。たとえば、gtavg コマンドはある次元に関する平均操作を行いますが、そうすると入力と比べて出力は1つ次元が少ないはずです。

例9に名前 "lon" の次元について平均を行うプログラムを示します。例が長いので、細切れにして説明します。

! --- 例9 ---
type(gt_variable):: src, mold, dest
integer:: cnt, siz, idim_avg
logical:: err
double precision:: dbuf(:), dsum(:)

call open(src, 入力変数名)
idim_avg = dimname_to_dimord(src, "lon")
if (idim_avg < 0) return
call slice(src, idim_avg, start=1, count=1, stride=1)

名前 "lon" で識別される次元番号は dimname_to_dimord で得られます。この次元番号について Slice しておくと、あとで Get→Slice_Next で得られるループは "lon" の次元に関して順次読み取ることになります。

call open(mold, src, dimord=0)
call del_dim(mold, idim_avg, err=err)
if (err) return
call create(dest, url=出力変数名, copyfrom=mold, &
    & copyvalue=.false., overwrite=.true., err=err)
call close(mold)
if (err) return

変数 src と同じ次元構成の変数を作るためには create(dest, copyfrom=src) としてしまえばよいのですが、次元を減らさなくてはいけないので、いったん mold という別の変数を Open しなおして、その次元を del_dim で削除してから create(dest, copyfrom=mold) しています。

call inquire(src, size=siz)
allocate(dbuf(siz), dsum(siz))
cnt = 0
dsum(1:siz) = 0.0d0

do
    call get(src, dbuf(1:siz), siz)
    where (dbuf(1:siz) /= undef)
	  dsum(1:siz) = dsum(1:siz) + dbuf(1:siz)
	  cnt = cnt + 1
    end where
    call slice_next(src, stat=stat)
    if (stat /= 0) exit
enddo

dsum(1:siz) = dsum(1:siz) / cnt
call put(dest, dsum(1:siz), siz)

call close(src)
call close(dest)

すでに Slice ずみの src について Slice_Next を呼び出すと、平均を取りたい次元 "lon" についてのループになります。ここで読み出した値 dbuf を集計した値 dsum を読み取り回数 cnt で割ると、平均値が得られます。

二つの変数の整合: gtbinary

二項演算子コマンド gtbinary ではもうひとつ問題が複雑になります。右項と左項の変数の次元構造は必ずしも同じとは限らないため、同じ回数 Slice_Next を呼んでも同じ場所を走査できるとは限りません。そこで、gtbinary では Transform で右項の変数を左項にあわせて変形してから処理を行います。

! --- 例10 ---
type(gt_variable):: lvar, rvar, ovar
double precision, allocatable:: lhsbuf(:), rhsbuf(:), obuf(:)
integer:: siz

call Open(lvar, 左項変数名)
call Open(rvar, 右項変数名)
call Transform(rvar, lvar)
call Create(ovar, url=出力変数名, copyfrom=lvar, copyvalue=.false.)
call Slice(lvar)
call Slice(rvar, compatible=lvar)
call Slice(ovar, compatible=lvar)
call Inquire(lvar, size=siz)
allocate(lhsbuf(siz), rhsbuf(siz), obuf(siz))
do
    call Get(lvar, lhsbuf, siz)
    call Get(rvar, rhsbuf, siz)
    obuf(1:siz) = lhsbuf(1:siz) + rhsbuf(1:siz)
    call Put(ovar, obuf, siz)
    call Slice_Next(lvar, stat=stat);  if (stat /= 0) exit
    call Slice_Next(rvar, stat=stat);  if (stat /= 0) exit
    call Slice_Next(ovar, stat=stat);  if (stat /= 0) exit
enddo
call Close(lvar)
call Close(rvar)
call Close(ovar)

続き