Path: | gtvardeldim.f90 |
Last Update: | Mon Jan 16 01:52:41 JST 2006 |
Authors: | Eizi TOYODA, Yasuhiro MORIKAWA |
Version: | $Id: gtvardeldim.f90,v 1.3 2006/01/15 16:52:41 morikawa Exp $ |
Tag Name: | $Name: gt4f90io-20070427 $ |
Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
License: | See COPYRIGHT |
以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Del_dim として提供されます。
Subroutine : | |
var : | type(gt_variable), intent(in) |
dimord : | integer, intent(in) |
err : | logical, intent(out) |
変数 var の次元 dimord を削除します。 次元対応表の順位を下げ有効次元数をデクリメントするだけなので、 当該次元がすでに縮退していれば、この操作のあとでも入出力が可能です。
エラーが生じた場合、メッセージを出力 してプログラムは強制終了します。err を与えてある場合には の引数に .true. が返り、プログラムは終了しません。
subroutine GTVarDelDim(var, dimord, err) ! !== 次元の削除 ! ! 変数 *var* の次元 *dimord* を削除します。 ! 次元対応表の順位を下げ有効次元数をデクリメントするだけなので、 ! 当該次元がすでに縮退していれば、この操作のあとでも入出力が可能です。 ! ! エラーが生じた場合、メッセージを出力 ! してプログラムは強制終了します。*err* を与えてある場合には ! の引数に .true. が返り、プログラムは終了しません。 ! ! use gtdata_types, only: gt_variable use gt_map, only: map_lookup, gt_dimmap, map_set_ndims, map_set use dc_trace, only: beginsub, endsub, DbgMessage implicit none type(gt_variable), intent(in):: var integer, intent(in):: dimord logical, intent(out):: err type(gt_dimmap), allocatable:: map(:) type(gt_dimmap):: tmpmap integer:: ndimsp, stat character(*), parameter:: subname = 'GTVarDelDim' continue err = .true. call beginsub(subname) if (dimord < 1) then call endsub(subname, "negative dimord=%d invalid", i=(/dimord/)) return endif call map_lookup(var, ndims=ndimsp) if (ndimsp <= 0) then call endsub(subname, "variable invalid") return else if (dimord > ndimsp) then call endsub(subname, "dimord=%d not exist", i=(/dimord/)) return endif allocate(map(ndimsp)) call map_lookup(var, map=map) tmpmap = map(dimord) map(dimord: ndimsp-1) = map(dimord+1: ndimsp) map(ndimsp) = tmpmap call map_set(var, map, stat) deallocate(map) call map_set_ndims(var, ndims = ndimsp - 1, stat=stat) err = stat /= 0 call endsub(subname) end subroutine GTVarDelDim