| Class | gt4_history |
| In: |
src/gt4_history.f90
|
This module is designed for output to gtool4 netCDF dataset sequentially along an axis (hereafter it will be called ‘time’). The name indicates that the module is originally intended to serve as the ‘history’ of atmospheric forecast models.
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | integer(INTK), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrInt0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
integer(INTK), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrInt0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrInt0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
integer(INTK), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrInt0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Int'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Intvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrInt0
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | logical, intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrLogical0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
logical, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrLogical0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Logical'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Logicalvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrLogical0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | logical, intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrLogical0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
logical, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrLogical0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrLogical0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrInt0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
integer(INTK), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrInt0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrInt0
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value(:) : | integer(INTK), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrInt1( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
integer(INTK), intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrInt1"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrInt1( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
integer(INTK), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrInt1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Int'
axis % attrs(attrs_num) % array = .true.
allocate( axis % attrs(attrs_num) % Intarray( size(value) ) )
axis % attrs(attrs_num) % Intarray = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrInt1
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrInt1( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
integer(INTK), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrInt1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrInt1
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrReal0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(SP), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrReal0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrReal0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(SP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrReal0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Real'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Realvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrReal0
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | logical, intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrLogical0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
logical, intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrLogical0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, value)
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, value)
endif
endif
call EndSub(subname)
end subroutine
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | character(*), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrChar0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
character(*), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrChar0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(value))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrChar0
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | character(*), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrChar0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
character(*), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrChar0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(value))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Char'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Charvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrChar0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrReal0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(SP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrReal0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrReal0
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | character(*), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrChar0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
character(*), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrChar0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(value))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, value)
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, value)
endif
endif
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrReal1( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(SP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrReal1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Real'
axis % attrs(attrs_num) % array = .true.
allocate( axis % attrs(attrs_num) % Realarray( size(value) ) )
axis % attrs(attrs_num) % Realarray = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrReal1
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrReal1( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(SP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrReal1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrReal1
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrDouble0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(DP), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrDouble0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrDouble0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(DP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrDouble0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Double'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Doublevalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrDouble0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrDouble0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(DP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrDouble0
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value(:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrDouble1( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(DP), intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrDouble1"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrDouble1( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(DP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrDouble1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Double'
axis % attrs(attrs_num) % array = .true.
allocate( axis % attrs(attrs_num) % Doublearray( size(value) ) )
axis % attrs(attrs_num) % Doublearray = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrDouble1
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrDouble1( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(DP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrDouble1
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value(:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrReal1( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(SP), intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrReal1"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varinfo_dest : | type(GT_HISTORY_VARINFO),intent(out) | ||
| varinfo_src : | type(GT_HISTORY_VARINFO),intent(in) | ||
| err : | logical, intent(out), optional | ||
| name : | character(*) , intent(in), optional
| ||
| dims(:) : | character(*) , intent(in), optional, target
| ||
| longname : | character(*) , intent(in), optional
| ||
| units : | character(*) , intent(in), optional
| ||
| xtype : | character(*) , intent(in), optional
|
終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.
subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err, name, dims, longname, units, xtype)
implicit none
type(GT_HISTORY_VARINFO),intent(out) :: varinfo_dest
type(GT_HISTORY_VARINFO),intent(in) :: varinfo_src
logical, intent(out), optional :: err
character(*) , intent(in), optional:: name ! 次元変数名
character(*) , intent(in), optional, target:: dims(:) ! 依存する次元
character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
character(*) , intent(in), optional:: units ! 次元変数の単位
character(*) , intent(in), optional:: xtype ! 次元変数の型
integer(INTK) :: i
character(TOKEN), pointer :: srcdims(:) =>null() ! 依存する次元
character(STRING), parameter:: subname = "HistoryVarinfoCopy1"
continue
call BeginSub(subname)
varinfo_dest % name = present_select('', varinfo_src % name, name)
varinfo_dest % longname = present_select('', varinfo_src % longname, longname)
varinfo_dest % units = present_select('', varinfo_src % units, units)
varinfo_dest % xtype = present_select('', varinfo_src % xtype, xtype)
if (present(dims)) then
srcdims => dims
else
srcdims => varinfo_src % dims
endif
allocate( varinfo_dest % dims( size( srcdims ) ) )
do i = 1, size(dims)
varinfo_dest % dims(i) = srcdims(i)
end do
if (associated( varinfo_src % attrs ) ) then
allocate( varinfo_dest % attrs( size( varinfo_src % attrs) ) )
call HistoryAttrCopy( from = varinfo_src % attrs, to = varinfo_dest % attrs, err = err)
end if
call EndSub(subname)
end subroutine HistoryVarinfoCopy1
| axis_dest : | type(GT_HISTORY_AXIS),intent(out) | ||
| axis_src : | type(GT_HISTORY_AXIS),intent(in) | ||
| err : | logical, intent(out), optional | ||
| name : | character(*) , intent(in), optional
| ||
| length : | integer(INTK), intent(in), optional
| ||
| longname : | character(*) , intent(in), optional
| ||
| units : | character(*) , intent(in), optional
| ||
| xtype : | character(*) , intent(in), optional
|
終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.
subroutine HistoryAxisCopy1(axis_dest, axis_src, err, name, length, longname, units, xtype)
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis_dest
type(GT_HISTORY_AXIS),intent(in) :: axis_src
logical, intent(out), optional :: err
character(*) , intent(in), optional:: name ! 次元変数名
integer(INTK), intent(in), optional:: length ! 次元長 (配列サイズ)
character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
character(*) , intent(in), optional:: units ! 次元変数の単位
character(*) , intent(in), optional:: xtype ! 次元変数の型
character(STRING), parameter:: subname = "HistoryAxisCopy1"
continue
call BeginSub(subname)
axis_dest % name = present_select('', axis_src % name, name)
axis_dest % length = present_select(.false., axis_src % length, length)
axis_dest % longname = present_select('', axis_src % longname, longname)
axis_dest % units = present_select('', axis_src % units, units)
axis_dest % xtype = present_select('', axis_src % xtype, xtype)
if (associated( axis_src % attrs ) ) then
allocate( axis_dest % attrs( size( axis_src % attrs) ) )
call HistoryAttrCopy( from = axis_src % attrs, to = axis_dest % attrs, err = err)
end if
call EndSub(subname)
end subroutine HistoryAxisCopy1
| hist_dest : | type(GT_HISTORY), intent(out), target | ||||||||||||||
| file : | character(*), intent(in) | ||||||||||||||
| hist_src : | type(GT_HISTORY), intent(in), optional, target | ||||||||||||||
| title : | character(*), intent(in), optional | ||||||||||||||
| source : | character(*), intent(in), optional | ||||||||||||||
| institution : | character(*), intent(in), optional | ||||||||||||||
| origin : | real, intent(in), optional
| ||||||||||||||
| interval : | real, intent(in), optional
| ||||||||||||||
| conventions : | character(*), intent(in), optional
| ||||||||||||||
| gt_version : | character(*), intent(in), optional
|
それ以降の引数は hist_src の設定を上書きするためのものである.
subroutine HistoryCopy1(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version)
! use dc_url, only:
! use dc_string, only:
implicit none
type(GT_HISTORY), intent(out), target :: hist_dest
character(*), intent(in) :: file
type(GT_HISTORY), intent(in), optional, target:: hist_src
character(*), intent(in), optional:: title, source, institution
!!!$ type(GT_HISTORY_AXIS), intent(in),optional :: axes(:)
!!!$ type(GT_HISTORY_AXIS), intent(in),optional :: addaxes(:)
!!!$ character(*), intent(in), optional:: dims(:)
!!!$ integer(INTK), intent(in), optional:: dimsizes(:)
!!!$ character(*), intent(in), optional:: longnames(:)
!!!$ character(*), intent(in), optional:: units(:)
real, intent(in), optional:: origin, interval
!!!$ character(*), intent(in), optional:: xtypes(:)
character(*), intent(in), optional:: conventions, gt_version
! Internal Work
type(GT_HISTORY), pointer:: src =>null()
character(STRING) :: title_src, source_src, institution_src
character(STRING) :: conventions_src, gt_version_src
character(STRING), pointer:: dims(:) => null()
integer(INTK) , pointer:: dimsizes(:) => null()
character(STRING), pointer:: longnames(:) => null()
character(STRING), pointer:: units(:) => null()
character(STRING), pointer:: xtypes(:) => null()
integer(INTK) :: i, numdims
logical :: err
real(DP),pointer :: dimvalue(:) => null()
character(len = *),parameter:: subname = "HistoryCopy1"
continue
call BeginSub(subname, 'file=<%c>', c1=trim(file))
if (present(hist_src)) then
src => hist_src
else
src => default
endif
numdims = size(src % dimvars)
call HistoryInquire1(history=src, title=title_src, source=source_src, institution=institution_src, dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, xtypes=xtypes, conventions=conventions_src, gt_version=gt_version_src)
call HistoryCreate1(file=trim(file), title=trim(present_select('', title_src, title)), source=trim(present_select('', source_src, source)), institution=trim(present_select('', institution_src, institution)), dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, origin=present_select(.false., src % origin, origin), interval=present_select(0.0, src % interval, interval), xtypes=xtypes, history=hist_dest, conventions=trim(present_select('', conventions_src, conventions)), gt_version=trim(present_select('', gt_version_src, gt_version)) )
!
! 次元変数が属性を持っている場合のことも考え, 最後に直接
! hist_dst % dimvars へ copy_attr (gtvarcopyattrall) をかける.
!
do i = 1, numdims
call Copy_Attr(hist_dest % dimvars(i), src % dimvars (i), global=.false.)
end do
! dimvars を Get してみて, 値を持っているようならデータを与えてしまう.
do i = 1, numdims
if (dimsizes(i) == 0) cycle
call Get(src % dimvars(i), dimvalue, err)
if (err) cycle
call HistoryPutDoubleEx(dims(i), dimvalue, size(dimvalue), hist_dest)
deallocate(dimvalue)
end do
deallocate(dims, dimsizes, longnames, units, xtypes)
call EndSub(subname)
end subroutine HistoryCopy1
| varinfo : | type(GT_HISTORY_VARINFO),intent(out) | ||
| name : | character(*) , intent(in)
| ||
| dims(:) : | character(*) , intent(in)
| ||
| longname : | character(*) , intent(in)
| ||
| units : | character(*) , intent(in)
| ||
| xtype : | character(*) , intent(in)
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryVarinfoCreate1( varinfo, name, dims, longname, units, xtype)
implicit none
type(GT_HISTORY_VARINFO),intent(out) :: varinfo
character(*) , intent(in):: name ! 次元変数名
character(*) , intent(in):: dims(:) ! 依存する次元
character(*) , intent(in):: longname ! 次元変数の記述的名称
character(*) , intent(in):: units ! 次元変数の単位
character(*) , intent(in):: xtype ! 次元変数の型
! Internal Work
integer(INTK):: i, numdims
character(len = *), parameter:: subname = "HistoryVarinfoCreate1"
continue
call BeginSub(subname)
varinfo % name = name
varinfo % longname = longname
varinfo % units = units
varinfo % xtype = xtype
numdims = size(dims)
allocate(varinfo % dims(numdims))
do i = 1, numdims
varinfo % dims(i) = dims(i)
if (len(trim(dims(i))) > TOKEN) then
call MessageNotify('W', subname, 'dimension name <%c> is trancated to <%c>', c1=trim(dims(i)), c2=trim(varinfo % dims(i)))
end if
end do
call EndSub(subname)
end subroutine HistoryVarinfoCreate1
| file : | character(len=*), intent(in) |
| title : | character(len=*), intent(in) |
| source : | character(len=*), intent(in) |
| institution : | character(len=*), intent(in) |
| dims(:) : | character(len=*), intent(in) |
| dimsizes(:) : | integer(INTK), intent(in) |
| longnames(:) : | character(len=*), intent(in) |
| units(:) : | character(len=*), intent(in) |
| origin : | real, intent(in) |
| interval : | real, intent(in) |
| xtypes(:) : | character(len=*), intent(in), optional |
| history : | type(GT_HISTORY), intent(out), optional, target |
| conventions : | character(len=*), intent(in), optional |
| gt_version : | character(len=*), intent(in), optional |
subroutine HistoryCreate1(file, title, source, institution, dims, dimsizes, longnames, units, origin, interval, xtypes, history, conventions, gt_version)
implicit none
character(len=*), intent(in) :: file
character(len=*), intent(in) :: title, source, institution
character(len=*), intent(in) :: dims(:)
integer(INTK), intent(in) :: dimsizes(:)
character(len=*), intent(in) :: longnames(:)
character(len=*), intent(in) :: units(:)
real, intent(in) :: origin, interval
character(len=*), intent(in), optional :: xtypes(:)
type(GT_HISTORY), intent(out), optional, target:: history
character(len=*), intent(in), optional:: conventions, gt_version
!=end
integer(INTK):: numdims, i, stat
type(GT_HISTORY), pointer:: hst =>null()
character(len = token):: my_xtype
character(len = string):: merged, x_inst, x_conv, x_gtver, nc_history
! gtool4 netCDF 規約の URL と最新バージョン (更新されたらここを変更)
character(len = string), parameter:: gtool4_netCDF_Conventions = "http://www.gfd-dennou.org/arch/gtool4/conventions/"
character(len = string), parameter:: newest_version = "4.2"
logical :: gtver_add
character(len = *), parameter:: subname = "HistoryCreate1"
continue
call BeginSub(subname, 'file=%c ndims=%d, %c', c1=trim(file), i=(/size(dims)/), c2='dims(:)=<' // trim(JoinChar(dims(:), ','))// '>, ' // 'dimsizes(:)=<' // trim(toChar(dimsizes(:))) // '>, ' // 'longnames(:)=<'// trim(JoinChar(longnames(:), '| ')) // '>, ' // 'units(:)=<' // trim(JoinChar(units(:), '
'))// '>, ' )
if (present(history)) then
hst => history
else
hst => default
endif
numdims = size(dims)
stat = DC_NOERR
if ( size(dimsizes) /= numdims .or. size(longnames) /= numdims .or. size(units) /= numdims ) then
stat = GT_EARGSIZEMISMATCH
goto 999
endif
! 次元変数表作成
allocate(hst % dimvars(numdims))
allocate(hst % dim_value_written(numdims))
hst % dim_value_written(:) = .false.
hst % unlimited_index = 0
nc_history = trim(TimeNow()) // ' unknown> gt4_history: HistoryCreate' // achar(10)
my_xtype = ""
do, i = 1, numdims
if (present(xtypes)) my_xtype = xtypes(i)
merged = UrlMerge(file=file, var=dims(i))
call Create( hst % dimvars(i), trim(merged), dimsizes(i), xtype=trim(my_xtype), overwrite=.TRUE.)
! conventions が存在しない場合はデフォルトの値を
! 属性 Conventions に付加。
if ( present_and_not_empty(conventions) ) then
x_conv = conventions
else
x_conv = gtool4_netCDF_Conventions
endif
! 1) gt_version がある場合、それを gt_version 属性に渡す。
! 2) gt_version が無い場合、conventions も無いか、または
! gtool4 netCDF 規約が入っていれば最新版を gt_version
! に与える。そうでない場合は gt_version 属性を与えない。
if (present(gt_version)) then
x_gtver = gt_version
gtver_add = .TRUE.
else
if (present(conventions) .and. .not. x_conv == gtool4_netCDF_Conventions) then
gtver_add = .FALSE.
else
x_gtver = newest_version
gtver_add = .TRUE.
endif
endif
call put_attr(hst % dimvars(i), '+Conventions', trim(x_conv))
if (gtver_add) then
call put_attr(hst % dimvars(i), '+gt_version', trim(x_gtver))
endif
! title, source, institution, history, long_name, units 属性の付加
call put_attr(hst % dimvars(i), '+title', title)
call put_attr(hst % dimvars(i), '+source', source)
if (institution /= "") then
x_inst = institution
else
x_inst = "a gt4_history (by GFD Dennou Club) user"
endif
call put_attr(hst % dimvars(i), '+institution', trim(x_inst))
call put_attr(hst % dimvars(i), '+history', trim(nc_history))
call put_attr(hst % dimvars(i), 'long_name', trim(longnames(i)))
call put_attr(hst % dimvars(i), 'units', trim(units(i)))
if (dimsizes(i) == 0) hst % unlimited_index = i
enddo
! 変数表
nullify(hst % vars, hst % growable_indices, hst % count)
! 時間カウンタ
hst % origin = origin
hst % interval = interval
hst % newest = origin
hst % oldest = origin
call EndSub(subname, 'std')
return
999 continue
call StoreError(stat, subname)
call EndSub(subname, 'err')
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(out) | ||
| name : | character(*) , intent(in)
| ||
| size : | integer(INTK), intent(in)
| ||
| longname : | character(*) , intent(in)
| ||
| units : | character(*) , intent(in)
| ||
| xtype : | character(*) , intent(in)
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryAxisCreate1( axis, name, size, longname, units, xtype)
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis
character(*) , intent(in):: name ! 次元変数名
integer(INTK), intent(in):: size ! 次元長 (配列サイズ)
character(*) , intent(in):: longname ! 次元変数の記述的名称
character(*) , intent(in):: units ! 次元変数の単位
character(*) , intent(in):: xtype ! 次元変数の型
character(len = *), parameter:: subname = "HistoryAxisCreate1"
continue
call BeginSub(subname)
axis % name = name
axis % length = size
axis % longname = longname
axis % units = units
axis % xtype = xtype
call EndSub(subname)
end subroutine HistoryAxisCreate1
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | integer(INTK), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrInt0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
integer(INTK), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrInt0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value(:) : | integer(INTK), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrInt1( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
integer(INTK), intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrInt1"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrReal0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(SP), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrReal0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrDouble0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(DP), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrDouble0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value(:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrDouble1( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(DP), intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrDouble1"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | character(*), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrChar0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
character(*), intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrChar0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(value))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, value)
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, value)
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value : | logical, intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrLogical0( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
logical, intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrLogical0"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, value)
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, value)
endif
endif
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| attrname : | character(*), intent(in) |
| value(:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), target, optional |
— 属性の設定 —
subroutine HistoryAddAttrReal1( varname, attrname, value, history)
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real(SP), intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer(INTK):: v_ord
logical:: err
character(len = *), parameter:: subname = "HistoryAddAttrReal1"
continue
call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
! 操作対象決定
if (present(history)) then
hst => history
else
hst => default
endif
if (varname == "") then
! とりあえず無駄だが大域属性を何度もつける
do, v_ord = 1, size(hst%vars)
call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
enddo
else
call lookup_var_or_dim(hst, varname, var, err)
if (.not. err) then
call Put_Attr(var, attrname, (/value/))
endif
endif
call EndSub(subname)
end subroutine
| varinfo : | type(GT_HISTORY_VARINFO), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional |
subroutine HistoryAddVariable2(varinfo, history)
implicit none
type(GT_HISTORY_VARINFO), intent(in) :: varinfo
type(GT_HISTORY), intent(inout), optional:: history
character(len = *), parameter:: subname = "HistoryAddVariable2"
continue
call BeginSub(subname, 'varname=<%c>, dims=<%c>, longname=<%c>', c1=trim(varinfo%name), c2=trim(JoinChar(varinfo%dims)), c3=trim(varinfo%longname) )
call HistoryAddVariable1(trim(varinfo%name), varinfo%dims, trim(varinfo%longname), trim(varinfo%units), trim(varinfo%xtype), history)
if (associated( varinfo % attrs )) then
call HistoryAttrAdd( varinfo % name, varinfo % attrs, history )
end if
call EndSub(subname)
end subroutine
| varname : | character(len = *), intent(in) |
| dims(:) : | character(len = *), intent(in) |
| longname : | character(len = *), intent(in) |
| units : | character(len = *), intent(in) |
| xtype : | character(len = *), intent(in), optional |
| history : | type(GT_HISTORY), intent(inout), optional, target |
各情報を直接引数として与える HistoryAddVariable
subroutine HistoryAddVariable1(varname, dims, longname, units, xtype, history)
implicit none
character(len = *), intent(in):: varname
character(len = *), intent(in):: dims(:)
character(len = *), intent(in):: longname, units
character(len = *), intent(in), optional:: xtype
type(GT_HISTORY), intent(inout), optional, target:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE), pointer:: vwork(:) =>null(), dimvars(:) =>null()
character(len = STRING):: fullname, url
integer(INTK), pointer:: count_work(:) =>null()
integer(INTK):: nvars, numdims, i, dimord
character(len = *), parameter:: subname = "HistoryAddVariable1"
continue
!----- 操作対象決定 -----
if (present(history)) then
hst => history
else
hst => default
endif
call BeginSub(subname, 'name=%c', c1=varname)
!----- 変数表拡張 -----
if (associated(hst%vars)) then
nvars = size(hst%vars(:))
vwork => hst%vars
count_work => hst%count
nullify(hst%vars, hst%count)
allocate(hst%vars(nvars + 1), hst%count(nvars + 1))
hst%vars(1:nvars) = vwork(1:nvars)
hst%count(1:nvars) = count_work(1:nvars)
deallocate(vwork, count_work)
count_work => hst%growable_indices
nullify(hst%growable_indices)
allocate(hst%growable_indices(nvars + 1))
hst%growable_indices(1:nvars) = count_work(1:nvars)
deallocate(count_work)
else
! トリッキーだが、ここで count だけ 2 要素確保するのは、
! HistorySetTime による巻き戻しに備えるため。
allocate(hst%vars(1), hst%count(2), hst%growable_indices(1))
hst%count(2) = 0
endif
nvars = size(hst%vars(:))
hst%growable_indices(nvars) = 0
hst%count(nvars) = 0
!----- 変数添字次元を決定 -----
numdims = size(dims(:))
allocate(dimvars(numdims))
do, i = 1, numdims
! hst 内で, 次元変数名 dim(i) に当たる次元変数の ID である
! hst%dimvar(i) を dimvars(i) に, 添字を dimord に
dimvars(i) = lookup_dimension(hst, dims(i), ord=dimord)
! 無制限次元の添字と一致する場合に,
! その添字を hst%growable_indices(nvars) に
if (dimord == hst%unlimited_index) then
hst%growable_indices(nvars) = i
endif
enddo
!----- 変数作成 -----
call Inquire(hst%dimvars(1), url=url)
fullname = UrlResolve((gt_atmark // trim(varname)), trim(url))
call Create(hst%vars(nvars), trim(fullname), dimvars, xtype=xtype)
! 拡張可能次元があったらそれをサイズ 1 に拡張しておく
if (hst%growable_indices(nvars) /= 0) then
call Slice(hst%vars(nvars), hst%growable_indices(nvars), start=1, count=1, stride=1)
endif
call put_attr(hst%vars(nvars), 'long_name', longname)
call put_attr(hst%vars(nvars), 'units', units)
deallocate(dimvars)
call EndSub(subname)
end subroutine
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | logical, intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrLogical0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
logical, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrLogical0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Logical'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Logicalvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrLogical0
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrReal1( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(SP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrReal1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Real'
axis % attrs(attrs_num) % array = .true.
allocate( axis % attrs(attrs_num) % Realarray( size(value) ) )
axis % attrs(attrs_num) % Realarray = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrReal1
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrReal0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(SP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrReal0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Real'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Realvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrReal0
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | character(*), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrChar0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
character(*), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrChar0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(value))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Char'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Charvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrChar0
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrDouble1( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(DP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrDouble1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Double'
axis % attrs(attrs_num) % array = .true.
allocate( axis % attrs(attrs_num) % Doublearray( size(value) ) )
axis % attrs(attrs_num) % Doublearray = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrDouble1
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrInt1( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
integer(INTK), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrInt1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Int'
axis % attrs(attrs_num) % array = .true.
allocate( axis % attrs(attrs_num) % Intarray( size(value) ) )
axis % attrs(attrs_num) % Intarray = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrInt1
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrInt0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
integer(INTK), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrInt0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Int'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Intvalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrInt0
| axis : | type(GT_HISTORY_AXIS),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryAxisAddAttrDouble0( axis, attrname, value)
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname
real(DP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryAxisAddAttrDouble0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryAxisInquire1( axis, name )
call DbgMessage('axis name=<%c>', c1=trim(name))
! これまでの属性を保持しつつ配列を1つ増やす
if ( .not. associated(axis % attrs) ) then
allocate( axis % attrs(1) )
attrs_num = 1
else
attrs_num = size( axis % attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(attrs_num - 1) )
call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( axis % attrs )
allocate( axis % attrs(attrs_num) )
call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
deallocate( attrs_tmp )
endif
axis % attrs(attrs_num) % attrname = attrname
axis % attrs(attrs_num) % attrtype = 'Double'
axis % attrs(attrs_num) % array = .false.
axis % attrs(attrs_num) % Doublevalue = value
call EndSub(subname)
end subroutine HistoryAxisAddAttrDouble0
| axis_dest : | type(GT_HISTORY_AXIS),intent(out) | ||
| axis_src : | type(GT_HISTORY_AXIS),intent(in) | ||
| err : | logical, intent(out), optional | ||
| name : | character(*) , intent(in), optional
| ||
| length : | integer(INTK), intent(in), optional
| ||
| longname : | character(*) , intent(in), optional
| ||
| units : | character(*) , intent(in), optional
| ||
| xtype : | character(*) , intent(in), optional
|
終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.
subroutine HistoryAxisCopy1(axis_dest, axis_src, err, name, length, longname, units, xtype)
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis_dest
type(GT_HISTORY_AXIS),intent(in) :: axis_src
logical, intent(out), optional :: err
character(*) , intent(in), optional:: name ! 次元変数名
integer(INTK), intent(in), optional:: length ! 次元長 (配列サイズ)
character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
character(*) , intent(in), optional:: units ! 次元変数の単位
character(*) , intent(in), optional:: xtype ! 次元変数の型
character(STRING), parameter:: subname = "HistoryAxisCopy1"
continue
call BeginSub(subname)
axis_dest % name = present_select('', axis_src % name, name)
axis_dest % length = present_select(.false., axis_src % length, length)
axis_dest % longname = present_select('', axis_src % longname, longname)
axis_dest % units = present_select('', axis_src % units, units)
axis_dest % xtype = present_select('', axis_src % xtype, xtype)
if (associated( axis_src % attrs ) ) then
allocate( axis_dest % attrs( size( axis_src % attrs) ) )
call HistoryAttrCopy( from = axis_src % attrs, to = axis_dest % attrs, err = err)
end if
call EndSub(subname)
end subroutine HistoryAxisCopy1
| axis : | type(GT_HISTORY_AXIS),intent(out) | ||
| name : | character(*) , intent(in)
| ||
| size : | integer(INTK), intent(in)
| ||
| longname : | character(*) , intent(in)
| ||
| units : | character(*) , intent(in)
| ||
| xtype : | character(*) , intent(in)
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryAxisCreate1( axis, name, size, longname, units, xtype)
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis
character(*) , intent(in):: name ! 次元変数名
integer(INTK), intent(in):: size ! 次元長 (配列サイズ)
character(*) , intent(in):: longname ! 次元変数の記述的名称
character(*) , intent(in):: units ! 次元変数の単位
character(*) , intent(in):: xtype ! 次元変数の型
character(len = *), parameter:: subname = "HistoryAxisCreate1"
continue
call BeginSub(subname)
axis % name = name
axis % length = size
axis % longname = longname
axis % units = units
axis % xtype = xtype
call EndSub(subname)
end subroutine HistoryAxisCreate1
| axis : | type(GT_HISTORY_AXIS),intent(in) | ||
| name : | character(*) , intent(out), optional
| ||
| size : | integer(INTK), intent(out), optional
| ||
| longname : | character(*) , intent(out), optional
| ||
| units : | character(*) , intent(out), optional
| ||
| xtype : | character(*) , intent(out), optional
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryAxisInquire1( axis, name, size, longname, units, xtype)
implicit none
type(GT_HISTORY_AXIS),intent(in) :: axis
character(*) , intent(out), optional:: name ! 次元変数名
integer(INTK), intent(out), optional:: size ! 次元長 (配列サイズ)
character(*) , intent(out), optional:: longname ! 次元変数の記述的名称
character(*) , intent(out), optional:: units ! 次元変数の単位
character(*) , intent(out), optional:: xtype ! 次元変数の型
character(len = *), parameter:: subname = "HistoryAxisInquire1"
continue
call BeginSub(subname)
if (present(name)) then
name = axis % name
end if
if (present(size)) then
size = axis % length
end if
if (present(longname)) then
longname = axis % longname
end if
if (present(units)) then
units = axis % units
end if
if (present(xtype)) then
xtype = axis % xtype
end if
call EndSub(subname)
end subroutine HistoryAxisInquire1
| hist_dest : | type(GT_HISTORY), intent(out), target | ||||||||||||||
| file : | character(*), intent(in) | ||||||||||||||
| hist_src : | type(GT_HISTORY), intent(in), optional, target | ||||||||||||||
| title : | character(*), intent(in), optional | ||||||||||||||
| source : | character(*), intent(in), optional | ||||||||||||||
| institution : | character(*), intent(in), optional | ||||||||||||||
| origin : | real, intent(in), optional
| ||||||||||||||
| interval : | real, intent(in), optional
| ||||||||||||||
| conventions : | character(*), intent(in), optional
| ||||||||||||||
| gt_version : | character(*), intent(in), optional
|
それ以降の引数は hist_src の設定を上書きするためのものである.
subroutine HistoryCopy1(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version)
! use dc_url, only:
! use dc_string, only:
implicit none
type(GT_HISTORY), intent(out), target :: hist_dest
character(*), intent(in) :: file
type(GT_HISTORY), intent(in), optional, target:: hist_src
character(*), intent(in), optional:: title, source, institution
!!!$ type(GT_HISTORY_AXIS), intent(in),optional :: axes(:)
!!!$ type(GT_HISTORY_AXIS), intent(in),optional :: addaxes(:)
!!!$ character(*), intent(in), optional:: dims(:)
!!!$ integer(INTK), intent(in), optional:: dimsizes(:)
!!!$ character(*), intent(in), optional:: longnames(:)
!!!$ character(*), intent(in), optional:: units(:)
real, intent(in), optional:: origin, interval
!!!$ character(*), intent(in), optional:: xtypes(:)
character(*), intent(in), optional:: conventions, gt_version
! Internal Work
type(GT_HISTORY), pointer:: src =>null()
character(STRING) :: title_src, source_src, institution_src
character(STRING) :: conventions_src, gt_version_src
character(STRING), pointer:: dims(:) => null()
integer(INTK) , pointer:: dimsizes(:) => null()
character(STRING), pointer:: longnames(:) => null()
character(STRING), pointer:: units(:) => null()
character(STRING), pointer:: xtypes(:) => null()
integer(INTK) :: i, numdims
logical :: err
real(DP),pointer :: dimvalue(:) => null()
character(len = *),parameter:: subname = "HistoryCopy1"
continue
call BeginSub(subname, 'file=<%c>', c1=trim(file))
if (present(hist_src)) then
src => hist_src
else
src => default
endif
numdims = size(src % dimvars)
call HistoryInquire1(history=src, title=title_src, source=source_src, institution=institution_src, dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, xtypes=xtypes, conventions=conventions_src, gt_version=gt_version_src)
call HistoryCreate1(file=trim(file), title=trim(present_select('', title_src, title)), source=trim(present_select('', source_src, source)), institution=trim(present_select('', institution_src, institution)), dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, origin=present_select(.false., src % origin, origin), interval=present_select(0.0, src % interval, interval), xtypes=xtypes, history=hist_dest, conventions=trim(present_select('', conventions_src, conventions)), gt_version=trim(present_select('', gt_version_src, gt_version)) )
!
! 次元変数が属性を持っている場合のことも考え, 最後に直接
! hist_dst % dimvars へ copy_attr (gtvarcopyattrall) をかける.
!
do i = 1, numdims
call Copy_Attr(hist_dest % dimvars(i), src % dimvars (i), global=.false.)
end do
! dimvars を Get してみて, 値を持っているようならデータを与えてしまう.
do i = 1, numdims
if (dimsizes(i) == 0) cycle
call Get(src % dimvars(i), dimvalue, err)
if (err) cycle
call HistoryPutDoubleEx(dims(i), dimvalue, size(dimvalue), hist_dest)
deallocate(dimvalue)
end do
deallocate(dims, dimsizes, longnames, units, xtypes)
call EndSub(subname)
end subroutine HistoryCopy1
| file : | character(len = *), intent(in)
| ||
| varname : | character(len = *), intent(in)
| ||
| history : | type(GT_HISTORY), intent(inout), optional, target |
変数のコピー (基本的に HistoryAddVariables と一緒)
subroutine HistoryCopyVariable1(file, varname, history)
implicit none
character(len = *), intent(in) :: file ! ファイル名
character(len = *), intent(in) :: varname ! 変数名 (元と先で共有)
type(GT_HISTORY), intent(inout), optional, target :: history
! 出力先
! 作業変数
type(GT_HISTORY), pointer :: hst =>null()
type(GT_VARIABLE), pointer :: vwork(:) =>null(), dimvars(:) =>null()
type(GT_VARIABLE) :: copyfrom
character(len = STRING) :: fullname, url, copyurl
integer(INTK), pointer :: count_work(:) =>null()
integer(INTK) :: nvars, numdims, i
logical :: growable
character(*), parameter :: subname = "HistoryCopyVariable"
continue
call BeginSub(subname, 'file=%c varname=%c', c1=trim(file), c2=trim(varname))
!----- 操作対象決定 -----
if (present(history)) then
hst => history
else
hst => default
endif
!----- 変数表拡張 -----
if (associated(hst%vars)) then
nvars = size(hst%vars(:))
vwork => hst%vars
count_work => hst%count
nullify(hst%vars, hst%count)
allocate(hst%vars(nvars + 1), hst%count(nvars + 1))
hst%vars(1:nvars) = vwork(1:nvars)
hst%count(1:nvars) = count_work(1:nvars)
deallocate(vwork, count_work)
count_work => hst%growable_indices
nullify(hst%growable_indices)
allocate(hst%growable_indices(nvars + 1))
hst%growable_indices(1:nvars) = count_work(1:nvars)
deallocate(count_work)
else
! トリッキーだが、ここで count だけ 2 要素確保するのは、
! HistorySetTime による巻き戻しに備えるため。
allocate(hst%vars(1), hst%count(2), hst%growable_indices(1))
hst%count(2) = 0
endif
nvars = size(hst%vars(:))
hst%growable_indices(nvars) = 0
hst%count(nvars) = 0
!----- コピー元ファイルの変数 ID 取得 -----
copyurl = UrlMerge(file, varname)
call Open(copyfrom, copyurl)
!----- 変数コピー -----
call Inquire(hst%dimvars(1), url=url)
fullname = UrlResolve((gt_atmark // trim(varname)), trim(url))
call Create(hst%vars(nvars), trim(fullname), copyfrom, copyvalue=.FALSE., overwrite=.TRUE.)
!----- 無制限次元の添字を探査 -----
call Inquire(hst%vars(nvars), alldims=numdims)
allocate(dimvars(numdims))
! 各次元毎に情報を取得し, growable == .TRUE. のもの (つまりは時間)
! の添字番号を取得する
do, i = 1, numdims
call Open(var=dimvars(i), source_var=hst%vars(nvars), dimord=i, count_compact=.TRUE.)
! 各次元変数の growable を調べる
call Inquire(var=dimvars(i), growable=growable)
if (growable) then
hst%growable_indices(nvars) = i
endif
enddo
!----- 拡張可能次元があったらそれをサイズ 1 に拡張しておく -----
if (hst%growable_indices(nvars) /= 0) then
call Slice(hst%vars(nvars), hst%growable_indices(nvars), start=1, count=1, stride=1)
endif
deallocate(dimvars)
call Close(copyfrom)
call EndSub(subname)
end subroutine
| file : | character(len=*), intent(in) |
| title : | character(len=*), intent(in) |
| source : | character(len=*), intent(in) |
| institution : | character(len=*), intent(in) |
| dims(:) : | character(len=*), intent(in) |
| dimsizes(:) : | integer(INTK), intent(in) |
| longnames(:) : | character(len=*), intent(in) |
| units(:) : | character(len=*), intent(in) |
| origin : | real, intent(in) |
| interval : | real, intent(in) |
| xtypes(:) : | character(len=*), intent(in), optional |
| history : | type(GT_HISTORY), intent(out), optional, target |
| conventions : | character(len=*), intent(in), optional |
| gt_version : | character(len=*), intent(in), optional |
subroutine HistoryCreate1(file, title, source, institution, dims, dimsizes, longnames, units, origin, interval, xtypes, history, conventions, gt_version)
implicit none
character(len=*), intent(in) :: file
character(len=*), intent(in) :: title, source, institution
character(len=*), intent(in) :: dims(:)
integer(INTK), intent(in) :: dimsizes(:)
character(len=*), intent(in) :: longnames(:)
character(len=*), intent(in) :: units(:)
real, intent(in) :: origin, interval
character(len=*), intent(in), optional :: xtypes(:)
type(GT_HISTORY), intent(out), optional, target:: history
character(len=*), intent(in), optional:: conventions, gt_version
!=end
integer(INTK):: numdims, i, stat
type(GT_HISTORY), pointer:: hst =>null()
character(len = token):: my_xtype
character(len = string):: merged, x_inst, x_conv, x_gtver, nc_history
! gtool4 netCDF 規約の URL と最新バージョン (更新されたらここを変更)
character(len = string), parameter:: gtool4_netCDF_Conventions = "http://www.gfd-dennou.org/arch/gtool4/conventions/"
character(len = string), parameter:: newest_version = "4.2"
logical :: gtver_add
character(len = *), parameter:: subname = "HistoryCreate1"
continue
call BeginSub(subname, 'file=%c ndims=%d, %c', c1=trim(file), i=(/size(dims)/), c2='dims(:)=<' // trim(JoinChar(dims(:), ','))// '>, ' // 'dimsizes(:)=<' // trim(toChar(dimsizes(:))) // '>, ' // 'longnames(:)=<'// trim(JoinChar(longnames(:), '| ')) // '>, ' // 'units(:)=<' // trim(JoinChar(units(:), '
'))// '>, ' )
if (present(history)) then
hst => history
else
hst => default
endif
numdims = size(dims)
stat = DC_NOERR
if ( size(dimsizes) /= numdims .or. size(longnames) /= numdims .or. size(units) /= numdims ) then
stat = GT_EARGSIZEMISMATCH
goto 999
endif
! 次元変数表作成
allocate(hst % dimvars(numdims))
allocate(hst % dim_value_written(numdims))
hst % dim_value_written(:) = .false.
hst % unlimited_index = 0
nc_history = trim(TimeNow()) // ' unknown> gt4_history: HistoryCreate' // achar(10)
my_xtype = ""
do, i = 1, numdims
if (present(xtypes)) my_xtype = xtypes(i)
merged = UrlMerge(file=file, var=dims(i))
call Create( hst % dimvars(i), trim(merged), dimsizes(i), xtype=trim(my_xtype), overwrite=.TRUE.)
! conventions が存在しない場合はデフォルトの値を
! 属性 Conventions に付加。
if ( present_and_not_empty(conventions) ) then
x_conv = conventions
else
x_conv = gtool4_netCDF_Conventions
endif
! 1) gt_version がある場合、それを gt_version 属性に渡す。
! 2) gt_version が無い場合、conventions も無いか、または
! gtool4 netCDF 規約が入っていれば最新版を gt_version
! に与える。そうでない場合は gt_version 属性を与えない。
if (present(gt_version)) then
x_gtver = gt_version
gtver_add = .TRUE.
else
if (present(conventions) .and. .not. x_conv == gtool4_netCDF_Conventions) then
gtver_add = .FALSE.
else
x_gtver = newest_version
gtver_add = .TRUE.
endif
endif
call put_attr(hst % dimvars(i), '+Conventions', trim(x_conv))
if (gtver_add) then
call put_attr(hst % dimvars(i), '+gt_version', trim(x_gtver))
endif
! title, source, institution, history, long_name, units 属性の付加
call put_attr(hst % dimvars(i), '+title', title)
call put_attr(hst % dimvars(i), '+source', source)
if (institution /= "") then
x_inst = institution
else
x_inst = "a gt4_history (by GFD Dennou Club) user"
endif
call put_attr(hst % dimvars(i), '+institution', trim(x_inst))
call put_attr(hst % dimvars(i), '+history', trim(nc_history))
call put_attr(hst % dimvars(i), 'long_name', trim(longnames(i)))
call put_attr(hst % dimvars(i), 'units', trim(units(i)))
if (dimsizes(i) == 0) hst % unlimited_index = i
enddo
! 変数表
nullify(hst % vars, hst % growable_indices, hst % count)
! 時間カウンタ
hst % origin = origin
hst % interval = interval
hst % newest = origin
hst % oldest = origin
call EndSub(subname, 'std')
return
999 continue
call StoreError(stat, subname)
call EndSub(subname, 'err')
end subroutine
| file : | character(*), intent(in) |
| title : | character(*), intent(in) |
| source : | character(*), intent(in) |
| institution : | character(*), intent(in) |
| axes(:) : | type(GT_HISTORY_AXIS), intent(in) |
| origin : | real(SP), intent(in) |
| interval : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(out), optional |
| conventions : | character(*), intent(in), optional |
| gt_version : | character(*), intent(in), optional |
subroutine HistoryCreate2(file, title, source, institution, axes, origin, interval, history, conventions, gt_version)
implicit none
character(*), intent(in) :: file
character(*), intent(in) :: title, source, institution
type(GT_HISTORY_AXIS), intent(in) :: axes(:)
real(SP), intent(in) :: origin, interval
type(GT_HISTORY), intent(out), optional:: history
character(*), intent(in), optional:: conventions, gt_version
! 構造体 GT_HISTORY_AXIS のデータ蓄積用
character(STRING), allocatable :: axes_name(:)
integer(INTK) , allocatable :: axes_length(:)
character(STRING), allocatable :: axes_longname(:)
character(STRING), allocatable :: axes_units(:)
character(STRING), allocatable :: axes_xtype(:)
integer(INTK) :: i, ndims
character(len = *), parameter:: subname = "HistoryCreate2"
continue
call BeginSub(subname, 'file=%c ndims=%d', c1=trim(file), i=(/size(axes)/) )
! 構造体 GT_HISTORY_AXIS の axes からのデータ取得
! (Fujitsu Fortran などなら axes(:)%name という表記で配列
! データをそのまま引き渡せるが、Intel Fortran 8 などだと
! その表記をまともに解釈してくれないので、美しくないけど
! いったん他の配列に情報を引き渡す)。2004/11/27 morikawa
ndims = size( axes(:) )
allocate( axes_name(ndims) )
allocate( axes_length(ndims) )
allocate( axes_longname(ndims) )
allocate( axes_units(ndims) )
allocate( axes_xtype(ndims) )
do i = 1, ndims
axes_name(i) = axes(i) % name
axes_length(i) = axes(i) % length
axes_longname(i) = axes(i) % longname
axes_units(i) = axes(i) % units
axes_xtype(i) = axes(i) % xtype
call DbgMessage('axes(%d):name=<%c>, length=<%d>, ' // 'longname=<%c>, units=<%c>' , i=(/i, axes(i) % length/) , c1=( trim(axes(i) % name) ) , c2=( trim(axes(i) % longname) ) , c3=( trim(axes(i) % units) ) )
enddo
call HistoryCreate1(file, title, source, institution, dims=axes_name(:), dimsizes=axes_length(:), longnames=axes_longname(:), units=axes_units(:), xtypes=axes_xtype(:), origin=origin, interval=interval, history=history, conventions=conventions, gt_version=gt_version)
! Fujitsu Fortran や Intel Fortran 7 、 SunStudio 8 などなら
! 可能な方法。Intel 8 に対応するため、上記のように
! 書き換えてみた。 2004/11/27 morikawa
! call HistoryCreate1(file, title, source, institution,
! dims=axes(:) % name, dimsizes=axes(:) % length,
! longnames=axes(:) % longname, units=axes(:) % units,
! xtypes=axes(:) % xtype,
! origin=origin, interval=interval,
! history=history, conventions=conventions,
! gt_version=gt_version)
deallocate( axes_name )
deallocate( axes_length )
deallocate( axes_longname )
deallocate( axes_units )
deallocate( axes_xtype )
do i = 1, ndims
if (.not. associated( axes(i) % attrs ) ) cycle
call HistoryAttrAdd( axes(i) % name, axes(i) % attrs, history )
end do
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal0TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array
real(SP) :: array_tmp(1)
character(*), parameter :: subname = "HistoryGetReal0TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array_tmp, slice=toChar(time))
call EndSub(subname)
array = array_tmp(1)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal5TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal5TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal6(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal6"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal0(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array
real(SP) :: array_tmp(1)
character(*), parameter :: subname = "HistoryGetReal0"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array_tmp, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array_tmp)
end if
array = array_tmp(1)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal0TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array
real(SP) :: array_tmp(1)
character(*), parameter :: subname = "HistoryGetReal0TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array_tmp, slice=toChar(time))
call EndSub(subname)
array = array_tmp(1)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal5TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal5TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal5(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal5"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal1(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:)
character(*), parameter :: subname = "HistoryGetReal1"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal1TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:)
character(*), parameter :: subname = "HistoryGetReal1TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal1TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:)
character(*), parameter :: subname = "HistoryGetReal1TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal2(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:,:)
character(*), parameter :: subname = "HistoryGetReal2"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal2TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:,:)
character(*), parameter :: subname = "HistoryGetReal2TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal2TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:,:)
character(*), parameter :: subname = "HistoryGetReal2TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal3(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetReal3"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal3TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetReal3TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal3TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetReal3TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble0(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array
real(DP) :: array_tmp(1)
character(*), parameter :: subname = "HistoryGetDouble0"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array_tmp, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array_tmp)
end if
array = array_tmp(1)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble0TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array
real(DP) :: array_tmp(1)
character(*), parameter :: subname = "HistoryGetDouble0TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array_tmp, slice=toChar(time))
call EndSub(subname)
array = array_tmp(1)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble0TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array
real(DP) :: array_tmp(1)
character(*), parameter :: subname = "HistoryGetDouble0TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array_tmp, slice=toChar(time))
call EndSub(subname)
array = array_tmp(1)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble1(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:)
character(*), parameter :: subname = "HistoryGetDouble1"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble1TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:)
character(*), parameter :: subname = "HistoryGetDouble1TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble1TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:)
character(*), parameter :: subname = "HistoryGetDouble1TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble2(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:,:)
character(*), parameter :: subname = "HistoryGetDouble2"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble2TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:,:)
character(*), parameter :: subname = "HistoryGetDouble2TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble2TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:,:)
character(*), parameter :: subname = "HistoryGetDouble2TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble3(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetDouble3"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble3TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetDouble3TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble3TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetDouble3TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble4(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble4"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble4TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble4TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble4TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble4TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble5(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble5"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble5TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble5TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal4(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal4"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal4TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal4TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble5TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble5TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble6(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble6"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble6TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble6TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble6TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble6TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetDouble7(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), intent(out) :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble7"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetDoubleEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble7TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble7TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble7TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), intent(out) :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble7TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDoubleEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal7TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal7TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal7TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal7TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), intent(out) |
| slice : | character(*), intent(in), optional |
入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.
subroutine HistoryGetReal7(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), intent(out) :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal7"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
if (present_and_not_empty(slice)) then
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=slice)
else
call HistoryGetRealEx(file=file, varname=varname, array=array)
endif
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal6TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal6TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), intent(out) |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal6TimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal6TimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), intent(out) |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal4TimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), intent(out) :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal4TimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetRealEx(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal7Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:,:,:,:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal7Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble7PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble7PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble7Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal0Pointer(file, varname, array, slice)
character(*), intent(in) :: file, varname
character(*), intent(in), optional :: slice
real(SP), pointer :: array
real(SP), target :: array_tmp(1)
type(GT_VARIABLE) :: var
character(STRING) :: url
integer(INTK):: domain ! 変数の入出力領域の大きさ
! (= 変数が依存する各次元サイズの積)
character(*), parameter :: subname = "HistoryGetReal0Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
allocate(array)
! いよいよデータ取得
call Open(var, url)
call Inquire(var=var, size=domain)
call Get(var, array_tmp, domain)
call Close(var)
array = array_tmp(1)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal0PointerTimeR(file, varname, array, time)
character(*), intent(in) :: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array
character(*), parameter :: subname = "HistoryGetReal0PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal0Pointer(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定.
subroutine HistoryGetReal0PointerTimeD(file, varname, array, time)
character(*), intent(in) :: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array
character(*), parameter :: subname = "HistoryGetReal0PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal0Pointer(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal1Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal1Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal1PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:)
character(*), parameter :: subname = "HistoryGetReal1PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal1Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal1PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:)
character(*), parameter :: subname = "HistoryGetReal1PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal1Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal2Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal2Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal2PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:,:)
character(*), parameter :: subname = "HistoryGetReal2PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal2Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal2PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:,:)
character(*), parameter :: subname = "HistoryGetReal2PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal2Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal3Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal3Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal3PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetReal3PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal3Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal3PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetReal3PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal3Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal4Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal4Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal4PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal4PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal4Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal4PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal4PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal4Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal5Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:,:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal5Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal5PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal5PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal5Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal5PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal5PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal5Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetReal6Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(SP), pointer :: array(:,:,:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetReal6Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal6PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal6PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal6Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal6PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal6PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal6Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble7Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:,:,:,:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble7Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetReal7PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal7PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal7Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetReal7PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(SP), pointer :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetReal7PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetReal7Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble0Pointer(file, varname, array, slice)
character(*), intent(in) :: file, varname
character(*), intent(in), optional :: slice
real(DP), pointer :: array
real(DP), target :: array_tmp(1)
type(GT_VARIABLE) :: var
character(STRING) :: url
integer(INTK):: domain ! 変数の入出力領域の大きさ
! (= 変数が依存する各次元サイズの積)
character(*), parameter :: subname = "HistoryGetDouble0Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
allocate(array)
! いよいよデータ取得
call Open(var, url)
call Inquire(var=var, size=domain)
call Get(var, array_tmp, domain)
call Close(var)
array = array_tmp(1)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble0PointerTimeR(file, varname, array, time)
character(*), intent(in) :: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array
character(*), parameter :: subname = "HistoryGetDouble0PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble0Pointer(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定.
subroutine HistoryGetDouble0PointerTimeD(file, varname, array, time)
character(*), intent(in) :: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array
character(*), parameter :: subname = "HistoryGetDouble0PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble0Pointer(file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble1Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble1Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble1PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:)
character(*), parameter :: subname = "HistoryGetDouble1PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble1Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble1PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:)
character(*), parameter :: subname = "HistoryGetDouble1PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble1Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble2Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble2Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble2PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:,:)
character(*), parameter :: subname = "HistoryGetDouble2PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble2Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble2PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:,:)
character(*), parameter :: subname = "HistoryGetDouble2PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble2Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble3Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble3Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble3PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetDouble3PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble3Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble3PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:,:,:)
character(*), parameter :: subname = "HistoryGetDouble3PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble3Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble4Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble4Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble4PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble4PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble4Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble4PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble4PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble4Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble5Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:,:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble5Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble5PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble5PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble5Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble5PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble5PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble5Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), pointer |
| slice : | character(*), intent(in), optional |
subroutine HistoryGetDouble6Pointer(file, varname, array, slice)
character(*), intent(in):: file, varname
character(*), intent(in), optional:: slice
real(DP), pointer :: array(:,:,:,:,:,:)
type(GT_VARIABLE) :: var
character(STRING) :: url
character(*), parameter :: subname = "HistoryGetDouble6Pointer"
continue
call BeginSub(subname, 'file=%c varname=%c slice=%c', c1=trim(file), c2=trim(varname), c3=trim(present_select('', 'no-slice', slice)))
! 必要な情報を gtool 変数化
call lookup_growable_url(file, varname, url, slice)
call DbgMessage('@ url =%c', c1=trim(url))
! いよいよデータ取得
call Open(var, url)
call Get(var, array)
call Close(var)
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble6PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble6PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble6Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), pointer |
| time : | real(DP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble6PointerTimeD(file, varname, array, time)
character(*), intent(in):: file, varname
real(DP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble6PointerTimeD"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble6Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| file : | character(*), intent(in) |
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), pointer |
| time : | real(SP), intent(in) |
将来廃止予定
subroutine HistoryGetDouble7PointerTimeR(file, varname, array, time)
character(*), intent(in):: file, varname
real(SP), intent(in) :: time
real(DP), pointer :: array(:,:,:,:,:,:,:)
character(*), parameter :: subname = "HistoryGetDouble7PointerTimeR"
continue
call BeginSub(subname, 'file=%c varname=%c time=%c', c1=trim(file), c2=trim(varname), c3=toChar(time))
call HistoryGetDouble7Pointer( file=file, varname=varname, array=array, slice=toChar(time))
call EndSub(subname)
end subroutine
| history : | character(*), intent(in) |
| file : | character(*), intent(out), optional |
| title : | character(*), intent(out), optional |
| source : | character(*), intent(out), optional |
| dims(:) : | character(*), pointer, optional |
| dimsizes(:) : | integer(INTK),pointer, optional |
| longnames(:) : | character(*), pointer, optional |
| units(:) : | character(*), pointer, optional |
| xtypes(:) : | character(*), pointer, optional |
| institution : | character(*), intent(out), optional |
| origin : | real(SP),intent(out), optional |
| interval : | real(SP),intent(out), optional |
| conventions : | character(*), intent(out), optional |
| gt_version : | character(*), intent(out), optional |
subroutine HistoryInquire2(history, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, conventions, gt_version )
implicit none
character(*), intent(in):: history
character(*), intent(out), optional:: file, title, source, institution
real(SP),intent(out), optional:: origin, interval
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:)
integer(INTK),pointer, optional:: dimsizes(:)
character(*), pointer, optional:: longnames(:)
character(*), pointer, optional:: units(:)
character(*), pointer, optional:: xtypes(:)
integer(INTK) :: stat
character(STRING) :: cause_c
character(*), parameter:: subname = "HistoryInquire2"
continue
call BeginSub(subname, "history=%c", c1=trim(history))
stat = DC_NOERR
cause_c = ''
if (trim(history) /= 'default') then
stat = NF_EINVAL
cause_c = 'history="' // trim(history) // '"'
goto 999
end if
call HistoryInquire1(default, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, conventions, gt_version )
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryInquire2
| history : | type(GT_HISTORY), intent(in) |
| file : | character(*), intent(out), optional |
| title : | character(*), intent(out), optional |
| source : | character(*), intent(out), optional |
| dims(:) : | character(*), pointer, optional |
| dimsizes(:) : | integer(INTK),pointer, optional |
| longnames(:) : | character(*), pointer, optional |
| units(:) : | character(*), pointer, optional |
| xtypes(:) : | character(*), pointer, optional |
| institution : | character(*), intent(out), optional |
| origin : | real(SP),intent(out), optional |
| interval : | real(SP),intent(out), optional |
| conventions : | character(*), intent(out), optional |
| gt_version : | character(*), intent(out), optional |
参照を行う. 現在, 情報を全て参照できるようにはなっていない.
subroutine HistoryInquire1(history, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, conventions, gt_version )
implicit none
type(GT_HISTORY), intent(in):: history
character(*), intent(out), optional:: file, title, source, institution
real(SP),intent(out), optional:: origin, interval
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:)
integer(INTK),pointer, optional:: dimsizes(:)
character(*), pointer, optional:: longnames(:)
character(*), pointer, optional:: units(:)
character(*), pointer, optional:: xtypes(:)
!!!$ type(GT_HISTORY_AXIS), intent(out), optional :: axes(:)
! Internal Work
character(STRING) :: url
integer(INTK) :: i, numdims
logical :: growable
character(*), parameter:: subname = "HistoryInquire1"
continue
call BeginSub(subname)
if (present(file)) then
call Inquire(history % dimvars(1), url=url)
call UrlSplit(fullname=url, file=file)
end if
if (present(title)) then
call Get_Attr(history % dimvars(1), '+title', title, 'unknown')
end if
if (present(source)) then
call Get_Attr(history % dimvars(1), '+source', source, 'unknown')
end if
if (present(institution)) then
call Get_Attr(history % dimvars(1), '+institution', institution, 'unknown')
end if
if (present(origin)) then
origin = history % origin
end if
if (present(interval)) then
interval = history % interval
end if
if (present(conventions)) then
call Get_Attr(history % dimvars(1), '+Conventions', conventions, 'unknown')
end if
if (present(gt_version)) then
call Get_Attr(history % dimvars(1), '+gt_version', gt_version, 'unknown')
end if
if (present(dims)) then
numdims = size(history % dimvars)
allocate(dims(numdims))
do i = 1, numdims
call Inquire(history % dimvars (i), name=dims(i))
end do
end if
if (present(dimsizes)) then
numdims = size(history % dimvars)
allocate(dimsizes(numdims))
do i = 1, numdims
call Inquire(history % dimvars (i), size=dimsizes(i), growable=growable)
if (growable) dimsizes(i) = 0
end do
end if
if (present(longnames)) then
numdims = size(history % dimvars)
allocate(longnames(numdims))
do i = 1, numdims
call Get_attr(history % dimvars (i), 'long_name', longnames(i), 'unknown')
end do
end if
if (present(units)) then
numdims = size(history % dimvars)
allocate(units(numdims))
do i = 1, numdims
call Get_attr(history % dimvars (i), 'units', units(i), 'unknown')
end do
end if
if (present(xtypes)) then
numdims = size(history % dimvars)
allocate(xtypes(numdims))
do i = 1, numdims
call Inquire(history % dimvars (i), xtype=xtypes(i))
end do
end if
call EndSub(subname)
end subroutine HistoryInquire1
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal5(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal5"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble3(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble3"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble2(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble2"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble0(varname, value, history)
character(*), intent(in):: varname
real(DP), intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble0"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, (/value/), 1, history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal7(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal7"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal6(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal6"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble4(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble4"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal4(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal4"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal3(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal3"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal2(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal2"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal1(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal1"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal0(varname, value, history)
character(*), intent(in):: varname
real(SP), intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal0"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, (/value/), 1, history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble5(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble5"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble6(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble6"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble7(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble7"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble1(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble1"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| time : | real, intent(in) | ||
| history : | type(GT_HISTORY), intent(inout), optional, target
|
時刻を明示設定している状態で、巻き戻しを含めた時間設定。 前進している間は検索をしないようになっている。
subroutine HistorySetTime(time, history)
implicit none
real, intent(in):: time
! hogehgoe
!
! herohero
type(GT_HISTORY), intent(inout), optional, target:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
real, pointer:: buffer(:) =>null()
logical:: err
continue
if (present(history)) then
hst => history
else
hst => default
endif
if (hst%unlimited_index == 0) then
return
endif
var = hst%dimvars(hst%unlimited_index)
hst%dim_value_written(hst%unlimited_index) = .TRUE.
if (time < hst%oldest .or. time > hst%newest .or. hst%count(2) == 0) then
hst%count(:) = maxval(hst%count(:)) + 1
hst%newest = max(hst%newest, time)
hst%oldest = min(hst%oldest, time)
call Slice(var, 1, start=hst%count(1), count=1)
call Put(var, (/time/), 1, err)
if (err) call DumpError()
return
endif
call Slice(var, 1, start=1, count=hst%count(2))
nullify(buffer)
call Get(var, buffer, err)
hst%count(1:1) = minloc(abs(buffer - time))
end subroutine
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | character(*), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrChar0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
character(*), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrChar0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(value))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrChar0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrDouble1( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(DP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrDouble1
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrDouble0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(DP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrDouble0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrReal1( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(SP), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrReal1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrReal1
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrReal0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
real(SP), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrReal0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrReal0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value(:) : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrInt1( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
integer(INTK), intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrInt1"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrInt1
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | integer(INTK), intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrInt0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
integer(INTK), intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrInt0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrInt0
| varinfo : | type(GT_HISTORY_VARINFO),intent(inout) |
| attrname : | character(*), intent(in) |
| value : | logical, intent(in) |
配列の 1 つ目の要素のみ値として付与される.
subroutine HistoryVarinfoAddAttrLogical0( varinfo, attrname, value)
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname
logical, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer(INTK):: attrs_num
character(STRING) :: name
character(*), parameter:: subname = "HistoryVarinfoAddAttrLogical0"
continue
call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
call HistoryVarinfoInquire1( 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 HistoryAttrCopy( from = varinfo % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
deallocate( varinfo % attrs )
allocate( varinfo % attrs(attrs_num) )
call HistoryAttrCopy( 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
call EndSub(subname)
end subroutine HistoryVarinfoAddAttrLogical0
| varinfo_dest : | type(GT_HISTORY_VARINFO),intent(out) | ||
| varinfo_src : | type(GT_HISTORY_VARINFO),intent(in) | ||
| err : | logical, intent(out), optional | ||
| name : | character(*) , intent(in), optional
| ||
| dims(:) : | character(*) , intent(in), optional, target
| ||
| longname : | character(*) , intent(in), optional
| ||
| units : | character(*) , intent(in), optional
| ||
| xtype : | character(*) , intent(in), optional
|
終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.
subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err, name, dims, longname, units, xtype)
implicit none
type(GT_HISTORY_VARINFO),intent(out) :: varinfo_dest
type(GT_HISTORY_VARINFO),intent(in) :: varinfo_src
logical, intent(out), optional :: err
character(*) , intent(in), optional:: name ! 次元変数名
character(*) , intent(in), optional, target:: dims(:) ! 依存する次元
character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
character(*) , intent(in), optional:: units ! 次元変数の単位
character(*) , intent(in), optional:: xtype ! 次元変数の型
integer(INTK) :: i
character(TOKEN), pointer :: srcdims(:) =>null() ! 依存する次元
character(STRING), parameter:: subname = "HistoryVarinfoCopy1"
continue
call BeginSub(subname)
varinfo_dest % name = present_select('', varinfo_src % name, name)
varinfo_dest % longname = present_select('', varinfo_src % longname, longname)
varinfo_dest % units = present_select('', varinfo_src % units, units)
varinfo_dest % xtype = present_select('', varinfo_src % xtype, xtype)
if (present(dims)) then
srcdims => dims
else
srcdims => varinfo_src % dims
endif
allocate( varinfo_dest % dims( size( srcdims ) ) )
do i = 1, size(dims)
varinfo_dest % dims(i) = srcdims(i)
end do
if (associated( varinfo_src % attrs ) ) then
allocate( varinfo_dest % attrs( size( varinfo_src % attrs) ) )
call HistoryAttrCopy( from = varinfo_src % attrs, to = varinfo_dest % attrs, err = err)
end if
call EndSub(subname)
end subroutine HistoryVarinfoCopy1
| varinfo : | type(GT_HISTORY_VARINFO),intent(out) | ||
| name : | character(*) , intent(in)
| ||
| dims(:) : | character(*) , intent(in)
| ||
| longname : | character(*) , intent(in)
| ||
| units : | character(*) , intent(in)
| ||
| xtype : | character(*) , intent(in)
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryVarinfoCreate1( varinfo, name, dims, longname, units, xtype)
implicit none
type(GT_HISTORY_VARINFO),intent(out) :: varinfo
character(*) , intent(in):: name ! 次元変数名
character(*) , intent(in):: dims(:) ! 依存する次元
character(*) , intent(in):: longname ! 次元変数の記述的名称
character(*) , intent(in):: units ! 次元変数の単位
character(*) , intent(in):: xtype ! 次元変数の型
! Internal Work
integer(INTK):: i, numdims
character(len = *), parameter:: subname = "HistoryVarinfoCreate1"
continue
call BeginSub(subname)
varinfo % name = name
varinfo % longname = longname
varinfo % units = units
varinfo % xtype = xtype
numdims = size(dims)
allocate(varinfo % dims(numdims))
do i = 1, numdims
varinfo % dims(i) = dims(i)
if (len(trim(dims(i))) > TOKEN) then
call MessageNotify('W', subname, 'dimension name <%c> is trancated to <%c>', c1=trim(dims(i)), c2=trim(varinfo % dims(i)))
end if
end do
call EndSub(subname)
end subroutine HistoryVarinfoCreate1
| varinfo : | type(GT_HISTORY_VARINFO),intent(in) | ||
| name : | character(*), intent(out), optional
| ||
| dims(:) : | character(*), pointer, optional
| ||
| longname : | character(*), intent(out), optional
| ||
| units : | character(*), intent(out), optional
| ||
| xtype : | character(*), intent(out), optional
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryVarinfoInquire1( varinfo, name, dims, longname, units, xtype)
implicit none
type(GT_HISTORY_VARINFO),intent(in) :: varinfo
character(*), intent(out), optional:: name ! 次元変数名
character(*), pointer, optional:: dims(:) ! 依存する次元
character(*), intent(out), optional:: longname ! 次元変数の記述的名称
character(*), intent(out), optional:: units ! 次元変数の単位
character(*), intent(out), optional:: xtype ! 次元変数の型
! Internal Work
integer(INTK):: i, numdims
character(*), parameter:: subname = "HistoryVarinfoInquire1"
continue
call BeginSub(subname)
if (present(name)) then
name = varinfo % name
end if
if (present(dims)) then
numdims = size(varinfo % dims)
allocate(dims(numdims))
do i = 1, numdims
dims(i) = varinfo % dims(i)
end do
end if
if (present(longname)) then
longname = varinfo % longname
end if
if (present(units)) then
units = varinfo % units
end if
if (present(xtype)) then
xtype = varinfo % xtype
end if
call EndSub(subname)
end subroutine HistoryVarinfoInquire1
| history : | type(GT_HISTORY), intent(in) |
| file : | character(*), intent(out), optional |
| title : | character(*), intent(out), optional |
| source : | character(*), intent(out), optional |
| dims(:) : | character(*), pointer, optional |
| dimsizes(:) : | integer(INTK),pointer, optional |
| longnames(:) : | character(*), pointer, optional |
| units(:) : | character(*), pointer, optional |
| xtypes(:) : | character(*), pointer, optional |
| institution : | character(*), intent(out), optional |
| origin : | real(SP),intent(out), optional |
| interval : | real(SP),intent(out), optional |
| conventions : | character(*), intent(out), optional |
| gt_version : | character(*), intent(out), optional |
参照を行う. 現在, 情報を全て参照できるようにはなっていない.
subroutine HistoryInquire1(history, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, conventions, gt_version )
implicit none
type(GT_HISTORY), intent(in):: history
character(*), intent(out), optional:: file, title, source, institution
real(SP),intent(out), optional:: origin, interval
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:)
integer(INTK),pointer, optional:: dimsizes(:)
character(*), pointer, optional:: longnames(:)
character(*), pointer, optional:: units(:)
character(*), pointer, optional:: xtypes(:)
!!!$ type(GT_HISTORY_AXIS), intent(out), optional :: axes(:)
! Internal Work
character(STRING) :: url
integer(INTK) :: i, numdims
logical :: growable
character(*), parameter:: subname = "HistoryInquire1"
continue
call BeginSub(subname)
if (present(file)) then
call Inquire(history % dimvars(1), url=url)
call UrlSplit(fullname=url, file=file)
end if
if (present(title)) then
call Get_Attr(history % dimvars(1), '+title', title, 'unknown')
end if
if (present(source)) then
call Get_Attr(history % dimvars(1), '+source', source, 'unknown')
end if
if (present(institution)) then
call Get_Attr(history % dimvars(1), '+institution', institution, 'unknown')
end if
if (present(origin)) then
origin = history % origin
end if
if (present(interval)) then
interval = history % interval
end if
if (present(conventions)) then
call Get_Attr(history % dimvars(1), '+Conventions', conventions, 'unknown')
end if
if (present(gt_version)) then
call Get_Attr(history % dimvars(1), '+gt_version', gt_version, 'unknown')
end if
if (present(dims)) then
numdims = size(history % dimvars)
allocate(dims(numdims))
do i = 1, numdims
call Inquire(history % dimvars (i), name=dims(i))
end do
end if
if (present(dimsizes)) then
numdims = size(history % dimvars)
allocate(dimsizes(numdims))
do i = 1, numdims
call Inquire(history % dimvars (i), size=dimsizes(i), growable=growable)
if (growable) dimsizes(i) = 0
end do
end if
if (present(longnames)) then
numdims = size(history % dimvars)
allocate(longnames(numdims))
do i = 1, numdims
call Get_attr(history % dimvars (i), 'long_name', longnames(i), 'unknown')
end do
end if
if (present(units)) then
numdims = size(history % dimvars)
allocate(units(numdims))
do i = 1, numdims
call Get_attr(history % dimvars (i), 'units', units(i), 'unknown')
end do
end if
if (present(xtypes)) then
numdims = size(history % dimvars)
allocate(xtypes(numdims))
do i = 1, numdims
call Inquire(history % dimvars (i), xtype=xtypes(i))
end do
end if
call EndSub(subname)
end subroutine HistoryInquire1
| history : | character(*), intent(in) |
| file : | character(*), intent(out), optional |
| title : | character(*), intent(out), optional |
| source : | character(*), intent(out), optional |
| dims(:) : | character(*), pointer, optional |
| dimsizes(:) : | integer(INTK),pointer, optional |
| longnames(:) : | character(*), pointer, optional |
| units(:) : | character(*), pointer, optional |
| xtypes(:) : | character(*), pointer, optional |
| institution : | character(*), intent(out), optional |
| origin : | real(SP),intent(out), optional |
| interval : | real(SP),intent(out), optional |
| conventions : | character(*), intent(out), optional |
| gt_version : | character(*), intent(out), optional |
subroutine HistoryInquire2(history, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, conventions, gt_version )
implicit none
character(*), intent(in):: history
character(*), intent(out), optional:: file, title, source, institution
real(SP),intent(out), optional:: origin, interval
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:)
integer(INTK),pointer, optional:: dimsizes(:)
character(*), pointer, optional:: longnames(:)
character(*), pointer, optional:: units(:)
character(*), pointer, optional:: xtypes(:)
integer(INTK) :: stat
character(STRING) :: cause_c
character(*), parameter:: subname = "HistoryInquire2"
continue
call BeginSub(subname, "history=%c", c1=trim(history))
stat = DC_NOERR
cause_c = ''
if (trim(history) /= 'default') then
stat = NF_EINVAL
cause_c = 'history="' // trim(history) // '"'
goto 999
end if
call HistoryInquire1(default, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, conventions, gt_version )
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryInquire2
| axis : | type(GT_HISTORY_AXIS),intent(in) | ||
| name : | character(*) , intent(out), optional
| ||
| size : | integer(INTK), intent(out), optional
| ||
| longname : | character(*) , intent(out), optional
| ||
| units : | character(*) , intent(out), optional
| ||
| xtype : | character(*) , intent(out), optional
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryAxisInquire1( axis, name, size, longname, units, xtype)
implicit none
type(GT_HISTORY_AXIS),intent(in) :: axis
character(*) , intent(out), optional:: name ! 次元変数名
integer(INTK), intent(out), optional:: size ! 次元長 (配列サイズ)
character(*) , intent(out), optional:: longname ! 次元変数の記述的名称
character(*) , intent(out), optional:: units ! 次元変数の単位
character(*) , intent(out), optional:: xtype ! 次元変数の型
character(len = *), parameter:: subname = "HistoryAxisInquire1"
continue
call BeginSub(subname)
if (present(name)) then
name = axis % name
end if
if (present(size)) then
size = axis % length
end if
if (present(longname)) then
longname = axis % longname
end if
if (present(units)) then
units = axis % units
end if
if (present(xtype)) then
xtype = axis % xtype
end if
call EndSub(subname)
end subroutine HistoryAxisInquire1
| varinfo : | type(GT_HISTORY_VARINFO),intent(in) | ||
| name : | character(*), intent(out), optional
| ||
| dims(:) : | character(*), pointer, optional
| ||
| longname : | character(*), intent(out), optional
| ||
| units : | character(*), intent(out), optional
| ||
| xtype : | character(*), intent(out), optional
|
$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none
| $ character(*) , intent(in): | name ! 次元変数名 |
| $ integer(INTK), intent(in): | size ! 次元長 (配列サイズ) |
| $ character(*) , intent(in): | longname ! 次元変数の記述的名称 |
| $ character(*) , intent(in): | units ! 次元変数の単位 |
| $ character(*) , intent(in): | xtype ! 次元変数の型 |
| $ character(len = *), parameter: | subname = "HistoryAxisCreate1" |
$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1
subroutine HistoryVarinfoInquire1( varinfo, name, dims, longname, units, xtype)
implicit none
type(GT_HISTORY_VARINFO),intent(in) :: varinfo
character(*), intent(out), optional:: name ! 次元変数名
character(*), pointer, optional:: dims(:) ! 依存する次元
character(*), intent(out), optional:: longname ! 次元変数の記述的名称
character(*), intent(out), optional:: units ! 次元変数の単位
character(*), intent(out), optional:: xtype ! 次元変数の型
! Internal Work
integer(INTK):: i, numdims
character(*), parameter:: subname = "HistoryVarinfoInquire1"
continue
call BeginSub(subname)
if (present(name)) then
name = varinfo % name
end if
if (present(dims)) then
numdims = size(varinfo % dims)
allocate(dims(numdims))
do i = 1, numdims
dims(i) = varinfo % dims(i)
end do
end if
if (present(longname)) then
longname = varinfo % longname
end if
if (present(units)) then
units = varinfo % units
end if
if (present(xtype)) then
xtype = varinfo % xtype
end if
call EndSub(subname)
end subroutine HistoryVarinfoInquire1
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal3(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal3"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal6(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal6"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal5(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal5"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal4(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal4"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble7(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble7"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal2(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal2"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal1(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal1"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| value : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal0(varname, value, history)
character(*), intent(in):: varname
real(SP), intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal0"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, (/value/), 1, history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble6(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble6"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| value : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble0(varname, value, history)
character(*), intent(in):: varname
real(DP), intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble0"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, (/value/), 1, history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble1(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble1"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble2(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble2"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble3(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble3"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble4(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble4"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:) : | real(DP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutDouble5(varname, array, history)
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutDouble5"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine
| varname : | character(*), intent(in) |
| array(:,:,:,:,:,:,:) : | real(SP), intent(in) |
| history : | type(GT_HISTORY), intent(inout), optional, target |
なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。
subroutine HistoryPutReal7(varname, array, history)
character(*), intent(in):: varname
real(SP), intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), parameter:: subname = "HistoryPutReal7"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history)
call EndSub(subname)
end subroutine