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-20101006 $ |
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