| Path: | gtvarclose.f90 |
| Last Update: | Tue Sep 23 18:56:15 +0900 2008 |
| Authors: | Yasuhiro MORIKAWA, Eizi TOYODA |
| Version: | $Id: gtvarclose.f90,v 1.1.1.1 2008-09-23 09:56:15 morikawa Exp $ |
| Tag Name: | $Name: gtool5-20090211 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
| License: | See COPYRIGHT |
以下のサブルーチン, 関数は gtdata_generic から提供されます。
| Subroutine : | |
| var : | type(GT_VARIABLE), intent(in), target |
| err : | logical, intent(out), optional |
変数 var の終了処理を行います。Open または Create されたものは プログラムの最後に必ずこのサブルーチンを用いて終了処理を行ってください。
終了処理の際にエラーが生じた場合、メッセージを出力してプログラムは 強制終了します。err を与えてある場合にはこの引数に .true. が返り、プログラムは終了しません。
subroutine GTVarClose(var, err)
!
!== 変数の終了処理
!
! 変数 *var* の終了処理を行います。Open または Create されたものは
! プログラムの最後に必ずこのサブルーチンを用いて終了処理を行ってください。
!
! 終了処理の際にエラーが生じた場合、メッセージを出力してプログラムは
! 強制終了します。*err* を与えてある場合にはこの引数に .true.
! が返り、プログラムは終了しません。
!
use gtdata_types, only: GT_VARIABLE
use gt_map, only: vtb_class_netcdf, vtb_class_memory, maptabdelete, map_lookup
use gt_vartable, only: vartabledelete, vartablelookup
use an_generic, only: ANVarClose, an_variable
use dc_error, only: StoreError, GT_EBADVAR, nf_enotvar, dc_noerr
use dc_trace, only: beginsub, endsub, DbgMessage
use gt_mem, only: mem_variable, Close
implicit none
type(GT_VARIABLE), intent(in), target:: var
logical, intent(out), optional:: err
integer:: vid, class, cid
logical:: action, myerr
continue
call beginsub('gtvarclose', fmt='var=%d', i=(/var%mapid/))
call map_lookup(var, vid=vid)
call maptabdelete(var, myerr)
if (myerr) goto 999
! vid が 0 になるのは dup_dimmap で作られたハンドル
if (vid == 0) goto 999
call vartablelookup(vid, class, cid)
call vartabledelete(vid, action, myerr)
if (myerr) goto 999
if (.not. action) then
call DbgMessage('refcount decrement only, no close internal var')
goto 999
else if (class == vtb_class_netcdf) then
call ANVarClose(an_variable(cid), myerr)
if (myerr) goto 999
else if (class == vtb_class_memory) then
call Close(mem_variable(cid))
myerr = .false.
else
call StoreError(GT_EBADVAR, "GTVarClose", err)
call endsub('GTVarClose', 'badvar')
myerr = .true.
endif
999 continue
call endsub('gtvarclose')
if (present(err)) err = myerr
end subroutine GTVarClose