| Path: | gtool/gtool_history/historyvarinfoaddattr.f90 |
| Last Update: | Tue Jun 22 23:13:45 +0900 2010 |
| Authors: | Yasuhiro MORIKAWA |
| Version: | $Id: historyvarinfoaddattr.f90,v 1.3 2010-06-22 14:13:45 morikawa Exp $ |
| Tag Name: | $Name: gtool5-20100705 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2000-2009. All rights reserved. |
| License: | See COPYRIGHT |
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | character(*), intent(in) | ||
| err : | logical, intent(out), optional |
使用方法は HistoryVarinfoAddAttr と同様です.
Usage is same as "HistoryVarinfoAddAttr".
subroutine HistoryVarinfoAddAttr2Char0( varinfo, attrname, value, err )
!
!
! 使用方法は HistoryVarinfoAddAttr と同様です.
!
! Usage is same as "HistoryVarinfoAddAttr".
!
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
character(*), intent(in):: value
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Char0"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Char0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | real(DP), intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Double0( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real(DP), intent(in):: value
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Double0"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Double0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value(:) : | real(DP), intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Double1( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real(DP), intent(in):: value(:)
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Double1"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Double1
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | integer, intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Int0( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Int0"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Int0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value(:) : | integer, intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Int1( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value(:)
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Int1"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Int1
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | logical, intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Logical0( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
logical, intent(in):: value
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Logical0"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Logical0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | real, intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Real0( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Real0"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Real0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value(:) : | real, intent(in) | ||
| err : | logical, intent(out), optional |
subroutine HistoryVarinfoAddAttr2Real1( varinfo, attrname, value, err )
!
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_generic, only: HistoryVarinfoAddAttr
use gtdata_generic, only: Put_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value(:)
logical, intent(out), optional:: err
character(*), parameter:: subname = "HistoryVarinfoAddAttr2Real1"
continue
call BeginSub(subname)
call HistoryVarinfoAddAttr( varinfo, attrname, value, err )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttr2Real1
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | character(*), intent(in)
| ||
| err : | logical, intent(out), optional
|
GT_HISTORY_VARINFO 型の変数 varinfo へ属性を付加します。
HistoryVarinfoAddAttr は複数のサブルーチンの総称名です。 value には様々な型の引数を与えることが可能です。 下記のサブルーチンを参照ください。
subroutine HistoryVarinfoAddAttrChar0( varinfo, attrname, value, err )
!
!
!== GT_HISTORY_VARINFO 型変数への属性付加
!
! GT_HISTORY_VARINFO 型の変数 *varinfo* へ属性を付加します。
!
! *HistoryVarinfoAddAttr* は複数のサブルーチンの総称名です。
! value には様々な型の引数を与えることが可能です。
! 下記のサブルーチンを参照ください。
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
character(*), intent(in):: value
! 属性に与えられる値
!
! 配列の場合でも、数値型以外
! では配列の 1 つ目の要素のみ
! 値として付加されます。
!
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrChar0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(value))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Char'
varinfo % attrs(attrs_num) % array = .false.
varinfo % attrs(attrs_num) % Charvalue = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrChar0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | real(DP), intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrDouble0( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real(DP), intent(in):: value
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Double'
varinfo % attrs(attrs_num) % array = .false.
varinfo % attrs(attrs_num) % Doublevalue = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrDouble0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value(:) : | real(DP), intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrDouble1( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real(DP), intent(in):: value(:)
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Double'
varinfo % attrs(attrs_num) % array = .true.
allocate( varinfo % attrs(attrs_num) % Doublearray( size(value) ) )
varinfo % attrs(attrs_num) % Doublearray = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrDouble1
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | integer, intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrInt0( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrInt0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Int'
varinfo % attrs(attrs_num) % array = .false.
varinfo % attrs(attrs_num) % Intvalue = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrInt0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value(:) : | integer, intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrInt1( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value(:)
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrInt1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Int'
varinfo % attrs(attrs_num) % array = .true.
allocate( varinfo % attrs(attrs_num) % Intarray( size(value) ) )
varinfo % attrs(attrs_num) % Intarray = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrInt1
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | logical, intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrLogical0( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
logical, intent(in):: value
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrLogical0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Logical'
varinfo % attrs(attrs_num) % array = .false.
varinfo % attrs(attrs_num) % Logicalvalue = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrLogical0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value : | real, intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrReal0( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrReal0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Real'
varinfo % attrs(attrs_num) % array = .false.
varinfo % attrs(attrs_num) % Realvalue = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrReal0
| Subroutine : | |||
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) | ||
| attrname : | character(*), intent(in)
| ||
| value(:) : | real, intent(in) | ||
| err : | logical, intent(out), optional
|
subroutine HistoryVarinfoAddAttrReal1( varinfo, attrname, value, err )
!
!
use gtool_history_generic, only: HistoryVarinfoInquire
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_types, only: STRING, TOKEN, DP
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value(:)
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: attrs_num, stat
character(STRING) :: name, cause_c
character(*), parameter:: subname = "HistoryVarinfoAddAttrReal1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
stat = DC_NOERR
cause_c = ''
if ( .not. varinfo % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GT_HISTORY_VARINFO'
goto 999
end if
call HistoryVarinfoInquire( varinfo, name )
call DbgMessage('varinfo name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(varinfo % attrs) ) then
allocate( varinfo % attrs(1) )
attrs_num = 1
else
attrs_num = size( varinfo % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call copy_attrs( from = attrs_tmp(1:attrs_num - 1), to = varinfo % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
varinfo % attrs(attrs_num) % attrname = attrname
varinfo % attrs(attrs_num) % attrtype = 'Real'
varinfo % attrs(attrs_num) % array = .true.
allocate( varinfo % attrs(attrs_num) % Realarray( size(value) ) )
varinfo % attrs(attrs_num) % Realarray = value
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrReal1