gtvarclose.f90

Path: gtvarclose.f90
Last Update: Mon Jan 16 04:07:25 JST 2006

変数の終了処理

Authors:Yasuhiro MORIKAWA, Eizi TOYODA
Version:$Id: gtvarclose.f90,v 1.4 2006/01/15 19:07:25 morikawa Exp $
Tag Name:$Name: gt4f90io-20080219 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン, 関数は gtdata_generic から提供されます。

Methods

GTVarClose  

Included Modules

gtdata_types gt_map gt_vartable an_generic dc_error dc_trace gt_mem

Public Instance methods

GTVarClose( var, [err] )
Subroutine :
var :type(GT_VARIABLE), intent(in), target
err :logical, intent(out), optional

変数の終了処理

変数 var の終了処理を行います。Open または Create されたものは プログラムの最後に必ずこのサブルーチンを用いて終了処理を行ってください。

終了処理の際にエラーが生じた場合、メッセージを出力してプログラムは 強制終了します。err を与えてある場合にはこの引数に .true. が返り、プログラムは終了しません。

[Source]

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

[Validate]