gtvarcopyattr.f90

Path: gtvarcopyattr.f90
Last Update: Sun Jan 15 19:04:57 JST 2006

属性のコピー

Authors:Eizi TOYODA, Yasuhiro MORIKAWA
Version:$Id: gtvarcopyattr.f90,v 1.3 2006/01/15 10:04:57 morikawa Exp $
Tag Name:$Name: gt4f90io-20060117 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Copy_Attr として提供されます。

Methods

GTVarCopyAttr  

Included Modules

gtdata_types dc_string gtdata_generic gt_map an_generic dc_trace dc_error

Public Instance methods

GTVarCopyAttr( to, attrname, from, [err] )
Subroutine :
to :type(GT_VARIABLE), intent(inout)
attrname :character(len = *), intent(in)
from :type(GT_VARIABLE), intent(in)
err :logical, intent(out), optional

属性のコピー

変数 from の属性 attrname を 変数 to へコピーします。

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

Copy_Attr は 2 つのサブルーチンの総称名であり、 他にも一括で変数の全ての属性をコピーする方法もあります。 下記のサブルーチンを参照ください。

[Source]

subroutine GTVarCopyAttr(to, attrname, from, err)
  !
  !== 属性のコピー
  !
  ! 変数 *from* の属性 *attrname* を 変数 *to* へコピーします。
  !
  ! 属性のコピー時にエラーが生じた場合、メッセージを出力
  ! してプログラムは強制終了します。*err* を与えてある場合には
  ! の引数に .true. が返り、プログラムは終了しません。
  !
  ! *Copy_Attr* は 2 つのサブルーチンの総称名であり、
  ! 他にも一括で変数の全ての属性をコピーする方法もあります。
  ! 下記のサブルーチンを参照ください。
  !
  use gtdata_types, only: GT_VARIABLE
  use dc_string
  use gtdata_generic, only: GET_ATTR, PUT_ATTR
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: copy_attr, an_variable
  use dc_trace, only: beginsub, endsub
  use dc_error, only: StoreError, DC_NOERR
  implicit none
  type(GT_VARIABLE), intent(inout):: to
  character(len = *), intent(in):: attrname
  type(GT_VARIABLE), intent(in):: from
  logical, intent(out), optional:: err
  type(VSTRING):: svalue
  integer:: from_class, from_cid, to_class, to_cid, stat
continue
  if (present(err)) err = .false.
  call beginsub('gtvarcopyattr', 'mapid to=%d from=%d name=%c',  i=(/to%mapid, from%mapid/), c1=attrname)
  call var_class(from, from_class, from_cid)
  call var_class(to, to_class, to_cid)
  if (from_class == vtb_class_netcdf .and. to_class == vtb_class_netcdf) then
    call Copy_Attr(an_variable(to_cid), attrname,  an_variable(from_cid), stat)
  else
    ! とりあえず文字列で入出力しておく
    call Get_Attr(from, attrname, svalue, default="")
    call Put_Attr(to, attrname, svalue, err)
    stat = DC_NOERR
  endif
  call StoreError(stat, "GTVarCopyAttr", err)
  call endsub('gtvarcopyattr', 'stat = %d', i=(/stat/))
end subroutine GTVarCopyAttr

[Validate]