!
!= 属性の付加
!
! Authors:: Eizi TOYODA, Yasuhiro MORIKAWA
! Version:: $Id: gtvarputattrchar.f90,v 1.5 2006/07/17 15:46:47 morikawa Exp $
! Tag Name:: $Name: gt4f90io-20070628 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License:: See COPYRIGHT[link:../../COPYRIGHT]
!
! 以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Put_Attr
! として提供されます。
subroutine GTVarPutAttrLogical(var, name, value, err)
!
!== 属性の付加
!
! 変数 *var* に, 属性名 *name* とその値 *value* を付加します。
!
! *Put_Attr* は複数のサブルーチンの総称名なので、
! *value* には様々な型の変数を与えることが可能です。
! 以下のサブルーチンを参照してください。
!
! 引数に *xtype* を持つものは、その引数に型を指定することで、
! 引数 *value* には文字型を与えても、
! 整数型、実数型 (単精度、倍精度) の値を付加することが可能です。
! 下記のサブルーチンを参照ください。
!
! エラーが発生した場合、引数 *err* が与えられる場合は *err* が
! .true. となって返ります。
! 引数 *err* を与えなければプログラムは停止します。
!
use gtdata_types, only: GT_VARIABLE
use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
use an_generic, only: put_attr, an_variable
use gt_mem, only: put_attr, mem_variable
use dc_string, only: toChar
implicit none
type(GT_VARIABLE), intent(inout) :: var
character(len = *), intent(in) :: name
logical, intent(in) :: value
logical, intent(out), optional:: err
integer:: class, cid
continue
call var_class(var, class, cid)
if (class == vtb_class_netcdf) then
if (value) then
call put_attr(an_variable(cid), name, "true", err=err)
else
call put_attr(an_variable(cid), name, "false", err=err)
endif
else if (class == vtb_class_memory) then
if (value) then
call put_attr(mem_variable(cid), name, "true")
else
call put_attr(mem_variable(cid), name, "false")
endif
if (present(err)) err = .false.
endif
end subroutine GTVarPutAttrLogical
!subroutine GTVarPutAttrString(var, name, value, err)
! !--
! ! VSTRING 型を引き取り上記 put_attr を呼び出す。下位層のことは関知しない
! !++
! use gtdata_types, only: GT_VARIABLE
! use dc_string, only: VSTRING, vchar, operator(==), len
! use gtdata_generic, only: put_attr
! implicit none
! type(GT_VARIABLE), intent(inout):: var
! character(len = *), intent(in):: name
! type(VSTRING), intent(in):: value
! logical, intent(out), optional:: err
!continue
! call put_attr(var, name, vchar(value, len(value)), err=err)
!end subroutine GTVarPutAttrString
subroutine GTVarPutAttrInt(var, name, value, err)
!
! まずは上記の Put_Attr
! (または GTVarPutAttrChar および GTVarPutAttrReal)
! を参照してください。
!
! *value* は配列を受け取るので、スカラーを書き出すには
! Fortran の配列構成子 (/ ... /) を使ってください。
! たとえば、スカラー a から長さ 1 の配列 (/a/)
! を作ることができます。
!
use gtdata_types, only: GT_VARIABLE
use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
use an_generic, only: put_attr, an_variable
use gt_mem, only: put_attr, mem_variable
use dc_string, only: toChar
type(GT_VARIABLE), intent(inout):: var
character(len = *), intent(in):: name
integer, intent(in):: value(:)
logical, intent(out), optional:: err
integer:: class, cid
continue
call var_class(var, class, cid)
if (class == vtb_class_netcdf) then
call put_attr(an_variable(cid), name, value, err)
else if (class == vtb_class_memory) then
call put_attr(mem_variable(cid), name, trim(toChar(value)))
if (present(err)) err = .false.
endif
end subroutine GTVarPutAttrInt
subroutine GTVarPutAttrReal(var, name, value, err)
!
! まずは上記の Put_Attr
! (または GTVarPutAttrChar および GTVarPutAttrReal)
! を参照してください。
!
use gtdata_types, only: GT_VARIABLE
use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
use an_generic, only: put_attr, an_variable
use gt_mem, only: put_attr, mem_variable
use dc_string, only: toChar
implicit none
type(GT_VARIABLE), intent(inout):: var
character(len = *), intent(in):: name
real, intent(in):: value(:)
logical, intent(out), optional:: err
integer:: class, cid
continue
call var_class(var, class, cid)
if (class == vtb_class_netcdf) then
call put_attr(an_variable(cid), name, value, err)
else if (class == vtb_class_memory) then
call put_attr(mem_variable(cid), name, trim(toChar(value)))
if (present(err)) err = .false.
endif
end subroutine GTVarPutAttrReal
subroutine GTVarPutAttrDouble(var, name, value, err)
!
! まずは上記の Put_Attr
! (または GTVarPutAttrChar および GTVarPutAttrReal)
! を参照してください。
!
use gtdata_types, only: GT_VARIABLE
use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
use an_generic, only: put_attr, an_variable
use gt_mem, only: put_attr, mem_variable
use dc_string, only: toChar
use dc_types, only: DP
implicit none
type(GT_VARIABLE), intent(inout):: var
character(len = *), intent(in):: name
real(DP), intent(in):: value(:)
logical, intent(out), optional:: err
integer:: class, cid
continue
call var_class(var, class, cid)
if (class == vtb_class_netcdf) then
call put_attr(an_variable(cid), name, value, err)
else if (class == vtb_class_memory) then
call put_attr(mem_variable(cid), name, trim(toChar(value)))
if (present(err)) err = .false.
endif
end subroutine GTVarPutAttrDouble
subroutine GTVarPutAttrChar(var, name, value, xtype, err)
!
! まずは上記の Put_Attr
! (または GTVarPutAttrChar)
! を参照してください。
!
! *xtype* に型を指定することで、引数 *value* には文字型を与えても、
! 整数型、実数型 (単精度、倍精度) の値を付加することが可能です。
!
! *xtype* には与える文字列として、以下のものが有効です。
! これら以外の場合は文字型の値が与えられます。
!
! 整数型 :: "INTEGER", "integer", "int"
! 実数型 (単精度) :: "REAL", "real", "float"
! 実数型 (倍精度) :: "DOUBLEPRECISION", "DOUBLE", "double"
!--
! anvarputattrchar.f90#ANVarPutAttrChar 参照
!++
!
use gtdata_types, only: GT_VARIABLE
use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
use an_generic, only: put_attr, an_variable
use gt_mem, only: put_attr, mem_variable
use dc_trace, only: beginsub, endsub
implicit none
type(GT_VARIABLE), intent(inout):: var
character(len = *), intent(in):: name
character(len = *), intent(in):: value
character(len = *), intent(in), optional:: xtype
logical, intent(out), optional:: err
integer:: class, cid
character(*), parameter:: subnam = "gtvarputattrchar"
continue
call beginsub(subnam, "%d:%c = %c", i=(/var%mapid/), c1=trim(name), c2=trim(value))
call var_class(var, class, cid)
if (class == vtb_class_netcdf) then
call put_attr(an_variable(cid), name, value, xtype, err)
else if (class == vtb_class_memory) then
call put_attr(mem_variable(cid), name, value)
if (present(err)) err = .false.
endif
call endsub(subnam)
end subroutine GTVarPutAttrChar