Public Instance methods
Subroutine : |
|
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, intent(in), optional
|
longname : | character(*) , intent(in), optional
|
units : | character(*) , intent(in), optional
|
xtype : | character(*) , intent(in), optional
|
GT_HISTORY_AXIS 型の変数
axis_src を axis_dest にコピーします。 axis_src は HistoryAxisCreate
によって初期設定されている必要が あります。 さらに属性を付加する場合には HistoryAxisAddAttr を用いてください。
err を与えておくと、コピーの際何らかの不具合が生じても 終了せずに
err が真になって返ります。
err 以降の引数は、コピーの際に上書きする値です。
[Source]
subroutine HistoryAxisCopy1(axis_dest, axis_src, err, name, length, longname, units, xtype)
!
!== GT_HISTORY_AXIS 型変数コピー
!
! GT_HISTORY_AXIS 型の変数 *axis_src* を
! *axis_dest* にコピーします。
! *axis_src* は HistoryAxisCreate によって初期設定されている必要が
! あります。
! さらに属性を付加する場合には HistoryAxisAddAttr
! を用いてください。
!
! *err* を与えておくと、コピーの際何らかの不具合が生じても
! 終了せずに err が真になって返ります。
!
! *err* 以降の引数は、コピーの際に上書きする値です。
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_present,only: present_select
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis_dest ! コピー先 GT_HISTORY_AXIS
type(GT_HISTORY_AXIS),intent(in) :: axis_src ! コピー元 GT_HISTORY_AXIS
logical, intent(out), optional :: err
character(*) , intent(in), optional:: name ! 次元変数名
integer, 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
Subroutine : |
|
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 の内容にコピーし, hist_dest へ返します.
hist_src が与えられない場合は, 引数 history
を与えずに呼び出した HistoryCreate
の設定内容が参照されます. HistoryCreate と同様に,
出力の初期設定を行います. file は必ず与えなければならず,
hist_src と同じファイルへ出力 しようとする場合はエラーを生じます. HistoryAddVariable
で設定される内容に関してはコピーされません.
それ以降の引数を与えることで, hist_src の設定を 上書きすることが可能です.
[Source]
subroutine HistoryCopy1(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version)
!
! 引数 *hist_src* の内容にコピーし, *hist_dest* へ返します. *hist_src*
! が与えられない場合は, 引数 *history* を与えずに呼び出した
! HistoryCreate の設定内容が参照されます.
! HistoryCreate と同様に, 出力の初期設定を行います. *file*
! は必ず与えなければならず, *hist_src* と同じファイルへ出力
! しようとする場合はエラーを生じます.
! HistoryAddVariable で設定される内容に関してはコピーされません.
!
! それ以降の引数を与えることで, hist_src の設定を
! 上書きすることが可能です.
!
use gtdata_generic, only: Inquire, Get_Attr, Copy_Attr, Get, Put
! use dc_url, only:
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH
! use dc_string, only:
use dc_present, only: present_select
use dc_types, only: string, token
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, 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 , pointer:: dimsizes(:) => null()
character(STRING), pointer:: longnames(:) => null()
character(STRING), pointer:: units(:) => null()
character(STRING), pointer:: xtypes(:) => null()
integer :: 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
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
|
GT_HISTORY_VARINFO 型の変数
varinfo_src を varinfo_dest にコピーします。
varinfo_src は HistoryVarinfoCreate
によって初期設定されている必要が あります。 さらに属性を付加する場合には HistoryVarinfoAddAttr
を用いてください。
err を与えておくと、コピーの際何らかの不具合が生じても 終了せずに
err が真になって返ります。
err 以降の引数は、コピーの際に上書きする値です。
[Source]
subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err, name, dims, longname, units, xtype)
!
!== GT_HISTORY_VARINFO 型変数コピー
!
! GT_HISTORY_VARINFO 型の変数 *varinfo_src* を
! *varinfo_dest* にコピーします。
! *varinfo_src* は HistoryVarinfoCreate によって初期設定されている必要が
! あります。
! さらに属性を付加する場合には HistoryVarinfoAddAttr
! を用いてください。
!
! *err* を与えておくと、コピーの際何らかの不具合が生じても
! 終了せずに err が真になって返ります。
!
! *err* 以降の引数は、コピーの際に上書きする値です。
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_present,only: present_select
use dc_string, only: JoinChar
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 :: 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
call DbgMessage('srcdims=<%c>', c1=trim(JoinChar(srcdims)))
allocate( varinfo_dest % dims( size( srcdims ) ) )
do i = 1, size(srcdims)
varinfo_dest % dims(i) = srcdims(i)
end do
call DbgMessage('varinfo_dest %% dims=<%c>', c1=trim(JoinChar(varinfo_dest % dims)))
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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(out)
|
name : | character(*) , intent(in)
|
size : | integer, intent(in)
|
longname : | character(*) , intent(in)
|
units : | character(*) , intent(in)
|
xtype : | character(*) , intent(in)
|
GT_HISTORY_AXIS 型変数を作成します。
このサブルーチンによる設定の後、 HistoryCreate の axes
に与えます。 さらに属性を付加する場合には HistoryAxisAddAttr を用いてください。
Constructor of GT_HISTORY_AXIS
[Source]
subroutine HistoryAxisCreate1( axis, name, size, longname, units, xtype)
!
!== GT_HISTORY_AXIS 型変数作成
!
! GT_HISTORY_AXIS 型変数を作成します。
! このサブルーチンによる設定の後、
! HistoryCreate の *axes* に与えます。
! さらに属性を付加する場合には HistoryAxisAddAttr
! を用いてください。
!
! Constructor of GT_HISTORY_AXIS
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis
character(*) , intent(in):: name ! 次元変数名
integer, 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
Subroutine : |
|
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)
|
GT_HISTORY_VARINFO
型変数を作成します。 このサブルーチンによる設定の後、 HistoryAddVariable の varinfo
に与えます。 さらに属性を付加する場合には HistoryVarinfoAddAttr
を用いてください。
Constructor of GT_HISTORY_VARINFO
[Source]
subroutine HistoryVarinfoCreate1( varinfo, name, dims, longname, units, xtype)
!
!== GT_HISTORY_VARINFO 型変数作成
!
! GT_HISTORY_VARINFO 型変数を作成します。
! このサブルーチンによる設定の後、
! HistoryAddVariable の *varinfo* に与えます。
! さらに属性を付加する場合には HistoryVarinfoAddAttr
! を用いてください。
!
! Constructor of GT_HISTORY_VARINFO
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_message, only: MessageNotify
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:: 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
GT_HISTORY
gtool4 netCDF データの出力用構造体
この型の変数は HistoryCreate
によって初期設定される必要があります。
初期設定後、データ出力用の複数のサブルーチンによって利用されます。
最終的には HistoryClose
によって終了処理してください。
この構造体の内部の要素は非公開になっています。 問い合わせの際には HistoryInquire を利用してください。
Data entity of this type represents a netCDF dataset controlled by gt4f90io library. It must be initialized by HistoryCreate , then used in many
subroutines, and must be finalized by HistoryClose . Note that the resultant
file is undefined if you forget to finalize it.
Users are recommended to retain the object of this type returned by HistoryCreate, to use it as the last
argument called history for all following subroutine calls. However,
it is not mandatory. When you are going to write ONLY one dataset,
argument history of all subroutine calls can be omitted, and the
history entity will be internally managed within this module.
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
: | 変数またはファイル全体に付 加する属性の名前
"+" (プラ ス) を属性名の先頭につける
場合には、ファイル全体に属 性を付加します。 ファイル全体へ属性を付加
する場合でも、 HistoryCreate の
dims 、または HistoryAddVariable の varname
で既に指定されてい る変数を varname に指定する 必要があります。
|
|
value : | character(*), intent(in)
|
history : | type(GT_HISTORY), target,
optional
: | 出力ファイルの設定に関する情報を 格納した構造体
ここに指定するものは、 HistoryCreate
によって初期設定 されていなければなりません。
|
|
gtool4 データ内の変数への属性付加
gtool4 データおよびそのデータ内の変数に属性を付加します。
このサブルーチンを用いる前に、 HistoryCreate による初期設定が
必要です。
属性名 attrname の先頭にプラス "+"
を付加する 場合は、gtool4 データ自体の属性 (大域属性)
として属性が付加されます この場合、varname
は無視されますが、その場合でも varname へは
引数の解説にもある通り有効な値を与えてください。
HistoryAddAttr
は複数のサブルーチンの総称名です。value には
いくつかの型を与えることが可能です。 下記のサブルーチンを参照ください。
[Source]
subroutine HistoryAddAttrChar0( varname, attrname, value, history)
!
!
!== gtool4 データ内の変数への属性付加
!
! gtool4 データおよびそのデータ内の変数に属性を付加します。
! このサブルーチンを用いる前に、 HistoryCreate による初期設定が
! 必要です。
!
! 属性名 *attrname* の先頭にプラス "<b><tt>+</tt></b>" を付加する
! 場合は、gtool4 データ自体の属性 (大域属性) として属性が付加されます
! この場合、*varname* は無視されますが、その場合でも *varname* へは
! 引数の解説にもある通り有効な値を与えてください。
!
! *HistoryAddAttr* は複数のサブルーチンの総称名です。*value* には
! いくつかの型を与えることが可能です。
! 下記のサブルーチンを参照ください。
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
implicit none
character(*), intent(in):: varname
! 変数の名前。
!
! ここで指定するものは、
! HistoryCreateの *dims* 、
! または HistoryAddVariable の
! *varname* で既に指定されてい
! なければなりません。
!
character(*), intent(in):: attrname
! 変数またはファイル全体に付
! 加する属性の名前
!
! "<b><tt>+</tt></b>" (プラ
! ス) を属性名の先頭につける
! 場合には、ファイル全体に属
! 性を付加します。
! ファイル全体へ属性を付加
! する場合でも、 HistoryCreate
! の *dims* 、または
! HistoryAddVariable の
! *varname* で既に指定されてい
! る変数を *varname* に指定する
! 必要があります。
!
character(*), intent(in):: value
! 属性の値
!
type(GT_HISTORY), target, optional:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value : | integer, intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrInt0( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
integer, intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value : | logical, intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrLogical0( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
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:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value : | real(DP), intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrDouble0( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
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:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value : | real, intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrReal0( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real, intent(in):: value
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value(:) : | integer, intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrInt1( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
integer, intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value(:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrDouble1( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
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:: 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
Subroutine : |
|
varname : | character(*), intent(in)
|
attrname : | character(*), intent(in)
|
value(:) : | real, intent(in)
|
history : | type(GT_HISTORY), target,
optional
|
[Source]
subroutine HistoryAddAttrReal1( varname, attrname, value, history)
!
!
use gtdata_generic, only: Put_Attr
use dc_string, only: toChar, JoinChar
use dc_url, only: GT_PLUS
use dc_error, only: DC_NOERR
implicit none
character(*), intent(in):: varname
character(*), intent(in):: attrname
real, intent(in):: value(:)
type(GT_HISTORY), target, optional:: history
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE):: var
integer:: 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
変数定義
gtool4 データ内の変数の定義を行います。このサブルーチンを 用いる前に、 HistoryCreate
による初期設定が必要です。
既に gtool4 データが存在し、そのデータ内の変数と全く同じ
構造の変数を定義したい場合は HistoryCopyVariable を利用すると
便利です。
HistoryAddVariable
というサブルーチン名は 2 つの別々の
サブルーチンの総称名です。下記のサブルーチンも参照ください。
[Source]
subroutine HistoryAddVariable2(varinfo, history)
!
!== 変数定義
!
! gtool4 データ内の変数の定義を行います。このサブルーチンを
! 用いる前に、 HistoryCreate による初期設定が必要です。
!
! 既に gtool4 データが存在し、そのデータ内の変数と全く同じ
! 構造の変数を定義したい場合は HistoryCopyVariable を利用すると
! 便利です。
!
! *HistoryAddVariable* というサブルーチン名は 2 つの別々の
! サブルーチンの総称名です。下記のサブルーチンも参照ください。
!
use dc_string, only: JoinChar
implicit none
type(GT_HISTORY_VARINFO), intent(in) :: varinfo
! 変数情報を格納した構造体
!
! ここに指定するものは、
! HistoryVarinfoCreate によって
! 初期設定されていなければなりません。
!
type(GT_HISTORY), intent(inout), optional:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
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 HistoryAddVariable2
Subroutine : |
|
varname : | character(len = *), intent(in)
: | 定義する変数の名前
最大文字数は dc_type#TOKEN
|
|
dims(:) : | character(len = *), intent(in)
: | 変数が依存する次元の名前
時間の次元は配列の最後に指定 しなければならない。 ここで指定するものは、 HistoryCreate にて dims で指定
されていなければならない。
もしもスカラー変数を作成 する場合には, サイズが 1 で 中身が空の文字型配列,
すなわち (/’’/) を与えること.
|
|
longname : | character(len = *), intent(in)
|
units : | character(len = *), intent(in)
|
xtype : | character(len = *), intent(in), optional
: | 変数のデータ型
デフォルトはfloat (単精度実数型) である。 有効なのは、 double
(倍精度実数型)、 int (整数型)である。 指定しない 場合や、無効な型を指定した
場合には、 float (単精度実数型) となる。
|
|
history : | type(GT_HISTORY), intent(inout),
optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体
ここに指定するものは、 HistoryCreate
によって初期設定 されていなければなりません。
|
|
変数定義
gtool4 データ内の変数の定義を行います。このサブルーチンを 用いる前に、 HistoryCreate
による初期設定が必要です。
既に gtool4 データが存在し、そのデータ内の変数と全く同じ
構造の変数を定義したい場合は HistoryCopyVariable を利用すると便
利です。
HistoryAddVariable
というサブルーチン名は 2 つの別々の
サブルーチンの総称名です。上記のサブルーチンも参照ください。
[Source]
subroutine HistoryAddVariable1(varname, dims, longname, units, xtype, history)
!
!== 変数定義
!
! gtool4 データ内の変数の定義を行います。このサブルーチンを
! 用いる前に、 HistoryCreate による初期設定が必要です。
!
! 既に gtool4 データが存在し、そのデータ内の変数と全く同じ
! 構造の変数を定義したい場合は HistoryCopyVariable を利用すると便
! 利です。
!
! *HistoryAddVariable* というサブルーチン名は 2 つの別々の
! サブルーチンの総称名です。上記のサブルーチンも参照ください。
!
use netcdf_f77, only: NF_EBADDIM
use dc_error, only: StoreError, DC_NOERR
use dc_string, only: CPrintf, JoinChar, StoA
use gtdata_generic, only: Inquire, Create, Slice, Put_Attr
use dc_url, only: GT_ATMARK, UrlResolve
use dc_types, only: STRING
implicit none
character(len = *), intent(in):: varname
! 定義する変数の名前
!
! 最大文字数は dc_type#TOKEN
!
character(len = *), intent(in):: dims(:)
! 変数が依存する次元の名前
!
! 時間の次元は配列の最後に指定
! しなければならない。
! ここで指定するものは、
! HistoryCreate にて dims で指定
! されていなければならない。
!
! もしもスカラー変数を作成
! する場合には, サイズが 1 で
! 中身が空の文字型配列,
! すなわち <tt> (/''/) </tt>
! を与えること.
!
character(len = *), intent(in):: longname
! 変数の記述的名称
!
! 最大文字数は dc_types#STRING
!
character(len = *), intent(in):: units
! 変数の単位
!
! 最大文字数は dc_types#STRING
!
character(len = *), intent(in), optional:: xtype
! 変数のデータ型
!
! デフォルトはfloat (単精度実数型)
! である。 有効なのは、
! double (倍精度実数型)、 int
! (整数型)である。 指定しない
! 場合や、無効な型を指定した
! 場合には、 float (単精度実数型)
! となる。
!
type(GT_HISTORY), intent(inout), optional, target:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
type(GT_HISTORY), pointer:: hst =>null()
type(GT_VARIABLE), pointer:: vwork(:) =>null(), dimvars(:) =>null()
character(len = STRING):: fullname, url, cause_c
integer, pointer:: count_work(:) =>null()
integer:: nvars, numdims, i, dimord, stat
character(len = *), parameter:: subname = "HistoryAddVariable1"
continue
call BeginSub(subname, 'name=<%a>, dims=<%a>, longname=<%a>, units=<%a>', ca=StoA(varname, JoinChar(dims), longname, units))
stat = DC_NOERR
!----- 操作対象決定 -----
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
! スカラー変数作成への対応
if (size(dims) == 1 .and. trim(dims(1)) == '') then
numdims = 0
allocate(dimvars(numdims))
else
numdims = size(dims)
allocate(dimvars(numdims))
end if
!----- 変数添字次元を決定 -----
do, i = 1, numdims
! hst 内で, 次元変数名 dim(i) に当たる次元変数の ID である
! hst%dimvar(i) を dimvars(i) に, 添字を dimord に
dimvars(i) = lookup_dimension(hst, dims(i), ord=dimord)
if (dimord == 0) then
stat = NF_EBADDIM
cause_c = CPrintf('"%c" dimension is not found.', c1=trim(dims(i)))
goto 999
end if
! 無制限次元の添字と一致する場合に,
! その添字を 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)
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryAddVariable1
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | character(*), intent(in)
: | 属性に与えられる値
配列の場合でも、数値型以外 では配列の 1 つ目の要素のみ
値として付加されます。
|
|
GT_HISTORY_AXIS 型の変数 axis
へ属性を付加します。
HistoryAxisAddAttr
は複数のサブルーチンの総称名です。 value
には様々な型の引数を与えることが可能です。
下記のサブルーチンを参照ください。
[Source]
subroutine HistoryAxisAddAttrChar0( axis, attrname, value)
!
!
!== GT_HISTORY_AXIS 型変数への属性付加
!
! GT_HISTORY_AXIS 型の変数 *axis* へ属性を付加します。
!
! *HistoryAxisAddAttr* は複数のサブルーチンの総称名です。
! value には様々な型の引数を与えることが可能です。
! 下記のサブルーチンを参照ください。
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
character(*), intent(in):: value
! 属性に与えられる値
!
! 配列の場合でも、数値型以外
! では配列の 1 つ目の要素のみ
! 値として付加されます。
!
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | integer, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrInt0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | logical, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrLogical0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real(DP), intent(in)
|
[Source]
subroutine HistoryAxisAddAttrDouble0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrReal0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | integer, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrInt1( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real(DP), intent(in)
|
[Source]
subroutine HistoryAxisAddAttrDouble1( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrReal1( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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 で与えられた変数を HistoryAxisCreate による初期設定よりも
さらに前の状態に初期化します。
Destructor of GT_HISTORY_AXIS
[Source]
subroutine HistoryAxisClear(axis)
!
!== GT_HISTORY_AXIS 型変数初期化
!
! *axis* で与えられた変数を HistoryAxisCreate による初期設定よりも
! さらに前の状態に初期化します。
!
! Destructor of GT_HISTORY_AXIS
!
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(len = *), parameter:: subname = "HistoryAxisClear1"
call BeginSub(subname)
axis % name = ""
axis % length = 0
axis % longname = ""
axis % units = ""
axis % xtype = ""
if (associated(axis % attrs)) then
deallocate(axis % attrs)
end if
call EndSub(subname)
end subroutine HistoryAxisClear
Subroutine : |
|
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, intent(in), optional
|
longname : | character(*) , intent(in), optional
|
units : | character(*) , intent(in), optional
|
xtype : | character(*) , intent(in), optional
|
GT_HISTORY_AXIS 型の変数
axis_src を axis_dest にコピーします。 axis_src は HistoryAxisCreate
によって初期設定されている必要が あります。 さらに属性を付加する場合には HistoryAxisAddAttr を用いてください。
err を与えておくと、コピーの際何らかの不具合が生じても 終了せずに
err が真になって返ります。
err 以降の引数は、コピーの際に上書きする値です。
[Source]
subroutine HistoryAxisCopy1(axis_dest, axis_src, err, name, length, longname, units, xtype)
!
!== GT_HISTORY_AXIS 型変数コピー
!
! GT_HISTORY_AXIS 型の変数 *axis_src* を
! *axis_dest* にコピーします。
! *axis_src* は HistoryAxisCreate によって初期設定されている必要が
! あります。
! さらに属性を付加する場合には HistoryAxisAddAttr
! を用いてください。
!
! *err* を与えておくと、コピーの際何らかの不具合が生じても
! 終了せずに err が真になって返ります。
!
! *err* 以降の引数は、コピーの際に上書きする値です。
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_present,only: present_select
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis_dest ! コピー先 GT_HISTORY_AXIS
type(GT_HISTORY_AXIS),intent(in) :: axis_src ! コピー元 GT_HISTORY_AXIS
logical, intent(out), optional :: err
character(*) , intent(in), optional:: name ! 次元変数名
integer, 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(out)
|
name : | character(*) , intent(in)
|
size : | integer, intent(in)
|
longname : | character(*) , intent(in)
|
units : | character(*) , intent(in)
|
xtype : | character(*) , intent(in)
|
GT_HISTORY_AXIS 型変数を作成します。
このサブルーチンによる設定の後、 HistoryCreate の axes
に与えます。 さらに属性を付加する場合には HistoryAxisAddAttr を用いてください。
Constructor of GT_HISTORY_AXIS
[Source]
subroutine HistoryAxisCreate1( axis, name, size, longname, units, xtype)
!
!== GT_HISTORY_AXIS 型変数作成
!
! GT_HISTORY_AXIS 型変数を作成します。
! このサブルーチンによる設定の後、
! HistoryCreate の *axes* に与えます。
! さらに属性を付加する場合には HistoryAxisAddAttr
! を用いてください。
!
! Constructor of GT_HISTORY_AXIS
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
implicit none
type(GT_HISTORY_AXIS),intent(out) :: axis
character(*) , intent(in):: name ! 次元変数名
integer, 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(in)
|
name : | character(*) , intent(out), optional
|
size : | integer, intent(out), optional
|
longname : | character(*) , intent(out), optional
|
units : | character(*) , intent(out), optional
|
xtype : | character(*) , intent(out), optional
|
GT_HISTORY_AXIS
型の変数内の各情報を参照します。
[Source]
subroutine HistoryAxisInquire1( axis, name, size, longname, units, xtype)
!
!== GT_HISTORY_AXIS 型変数への問い合わせ
!
! GT_HISTORY_AXIS 型の変数内の各情報を参照します。
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
implicit none
type(GT_HISTORY_AXIS),intent(in) :: axis
character(*) , intent(out), optional:: name ! 次元変数名
integer, 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
Subroutine : |
|
history : | type(GT_HISTORY), intent(inout),
optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体
ここに指定するものは、 HistoryCreate
によって初期設定 されていなければなりません。
|
|
終了処理
HistoryCreate
で始まったデータ出力の終了処理をおこなうものです。 プログラム内で HistoryCreate
を用いた場合、プログラムを終了する 前に必ずこのサブルーチンを呼んで下さい。
[Source]
subroutine HistoryClose(history)
!
!== 終了処理
!
! HistoryCreate で始まったデータ出力の終了処理をおこなうものです。
! プログラム内で HistoryCreate を用いた場合、プログラムを終了する
! 前に必ずこのサブルーチンを呼んで下さい。
!
use gtdata_generic, only: Close
type(GT_HISTORY), intent(inout), optional, target:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
type(GT_HISTORY), pointer:: hst =>null()
integer:: i
character(len = *), parameter:: subname = "HistoryClose"
continue
call BeginSub(subname)
if (present(history)) then
hst => history
else
hst => default
endif
do, i = 1, size(hst%dimvars)
if (.not. hst%dim_value_written(i)) call set_fake_dim_value(hst, i)
call Close(hst%dimvars(i))
enddo
deallocate(hst%dimvars)
do, i = 1, size(hst%vars)
call Close(hst%vars(i))
enddo
if (associated(hst%vars)) deallocate(hst%vars)
if (associated(hst%count)) deallocate(hst%count)
call EndSub(subname)
end subroutine HistoryClose
Subroutine : |
|
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 の内容にコピーし, hist_dest へ返します.
hist_src が与えられない場合は, 引数 history
を与えずに呼び出した HistoryCreate
の設定内容が参照されます. HistoryCreate と同様に,
出力の初期設定を行います. file は必ず与えなければならず,
hist_src と同じファイルへ出力 しようとする場合はエラーを生じます. HistoryAddVariable
で設定される内容に関してはコピーされません.
それ以降の引数を与えることで, hist_src の設定を 上書きすることが可能です.
[Source]
subroutine HistoryCopy1(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version)
!
! 引数 *hist_src* の内容にコピーし, *hist_dest* へ返します. *hist_src*
! が与えられない場合は, 引数 *history* を与えずに呼び出した
! HistoryCreate の設定内容が参照されます.
! HistoryCreate と同様に, 出力の初期設定を行います. *file*
! は必ず与えなければならず, *hist_src* と同じファイルへ出力
! しようとする場合はエラーを生じます.
! HistoryAddVariable で設定される内容に関してはコピーされません.
!
! それ以降の引数を与えることで, hist_src の設定を
! 上書きすることが可能です.
!
use gtdata_generic, only: Inquire, Get_Attr, Copy_Attr, Get, Put
! use dc_url, only:
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH
! use dc_string, only:
use dc_present, only: present_select
use dc_types, only: string, token
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, 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 , pointer:: dimsizes(:) => null()
character(STRING), pointer:: longnames(:) => null()
character(STRING), pointer:: units(:) => null()
character(STRING), pointer:: xtypes(:) => null()
integer :: 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
Subroutine : |
|
file : | character(len = *), intent(in)
: | コピーしようとする変数が格納された netCDF ファイル名
|
|
varname : | character(len = *), intent(in)
: | コピー元となる変数の名前
定義される変数名もこれと 同じになります。 最大文字数は dc_types#TOKEN 。
依存する次元が存在しない 場合は自動的にその次元に関する
変数情報も元のファイルから コピーします。 この場合に「同じ次元」と見
なされるのは、(1) 無制限次 元 (自動的に「時間」と認識 される)、 (2)
サイズと単位が同じ次元、 です。
|
|
history : | type(GT_HISTORY), intent(inout),
optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体
ここに指定するものは、 HistoryCreate
によって初期設定 されていなければなりません。
|
|
overwrite : | logical, intent(in), optional
: | 上書きの可否の設定
この引数に .false. を渡すと、 既存のファイルを上書きしません。
デフォルトは上書きします。
|
|
変数定義 (別ファイルの変数コピー)
gtool4 データ内の変数の定義を行います。 他の gtool4 データの
ファイル名とその中の変数名を指定することで、 自動的のその変数の
構造や属性をコピーして変数定義します。このサブルーチンを 用いる前に、 HistoryCreate
による初期設定が必要です。
構造や属性を手動で設定する場合には HistoryAddVariable を用いて下さい。
[Source]
subroutine HistoryCopyVariable1(file, varname, history, overwrite)
!
!== 変数定義 (別ファイルの変数コピー)
!
! gtool4 データ内の変数の定義を行います。 他の gtool4 データの
! ファイル名とその中の変数名を指定することで、 自動的のその変数の
! 構造や属性をコピーして変数定義します。このサブルーチンを
! 用いる前に、 HistoryCreate による初期設定が必要です。
!
! 構造や属性を手動で設定する場合には HistoryAddVariable
! を用いて下さい。
!
use gtdata_generic, only: Create, Inquire, Open, Slice, Close
use dc_present, only: present_and_false
use dc_url, only: UrlMerge, GT_ATMARK, UrlResolve
use dc_types, only: STRING
implicit none
character(len = *), intent(in) :: file
! コピーしようとする変数が格納された
! netCDF ファイル名
!
character(len = *), intent(in) :: varname
! コピー元となる変数の名前
!
! 定義される変数名もこれと
! 同じになります。
! 最大文字数は dc_types#TOKEN 。
!
! 依存する次元が存在しない
! 場合は自動的にその次元に関する
! 変数情報も元のファイルから
! コピーします。
! この場合に「同じ次元」と見
! なされるのは、(1) 無制限次
! 元 (自動的に「時間」と認識
! される)、
! (2) サイズと単位が同じ次元、
! です。
!
type(GT_HISTORY), intent(inout), optional, target :: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
logical, intent(in), optional:: overwrite
! 上書きの可否の設定
!
! この引数に .false. を渡すと、
! 既存のファイルを上書きしません。
! デフォルトは上書きします。
!
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, pointer :: count_work(:) =>null()
integer :: nvars, numdims, i
logical :: growable, overwrite_required
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))
overwrite_required = .true.
if (present_and_false(overwrite)) overwrite_required = .false.
call Create(hst%vars(nvars), trim(fullname), copyfrom, copyvalue=.FALSE., overwrite=overwrite_required)
!----- 無制限次元の添字を探査 -----
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 HistoryCopyVariable1
HistoryCreate( file, title, source, institution, axes, [origin], [interval], [history], [conventions], [gt_version], [overwrite] )
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, intent(in), optional
|
interval : | real, intent(in), optional
|
history : | type(GT_HISTORY), intent(out),
optional
|
conventions : | character(*), intent(in), optional
|
gt_version : | character(*), intent(in), optional
|
overwrite : | logical, intent(in), optional
|
gtool4 データ出力用初期設定
HistoryCreate
というサブルーチン名は 2 つの別々の サブルーチンの総称名です。まずは HistoryCreate を参照ください。
もう 1 つのサブルーチンと異なる点は、座標軸の情報を dims,
dimsizes, longnames, units, and xtypes といった
個別の引数で与えるのではなく、構造体 GT_HISTORY_AXIS 型の 引数 axes
で与える点にあります。
GT_HISTORY_AXIS 型変数の生成
(constructer) は HistoryAxisCreate
にて行います。
Two specific subroutines shares common part:
Both two ones initializes a dataset file. The result of type GT_HISTORY will be returned by
history or managed internally if omitted. Mandatory global
attributes are defined by arguments title, source, and
institution; they are all declared as ((character(len = *))).
Spatial axis definitions have two different forms: a primitive one uses
several arrays of various types: dims, dimsizes,
longnames, units, and xtypes. Another sophisticated
one has only array of type GT_HISTORY_AXIS, axes. Temporal
definition is done without origin, interval.
[Source]
subroutine HistoryCreate2(file, title, source, institution, axes, origin, interval, history, conventions, gt_version, overwrite)
!
!== gtool4 データ出力用初期設定
!
! *HistoryCreate* というサブルーチン名は 2 つの別々の
! サブルーチンの総称名です。まずは HistoryCreate を参照ください。
!
! もう 1 つのサブルーチンと異なる点は、座標軸の情報を
! *dims*, *dimsizes*, *longnames*, *units*, and *xtypes* といった
! 個別の引数で与えるのではなく、構造体 GT_HISTORY_AXIS 型の
! 引数 *axes* で与える点にあります。
!
! GT_HISTORY_AXIS 型変数の生成 (constructer) は
! HistoryAxisCreate にて行います。
!
!
! Two specific subroutines shares common part:
!
! Both two ones initializes a dataset *file*.
! The result of type GT_HISTORY will be returned by *history*
! or managed internally if omitted.
! Mandatory global attributes are defined by arguments
! *title*, *source*, and *institution*;
! they are all declared as ((character(len = *))).
! Spatial axis definitions have two different forms:
! a primitive one uses several arrays of various types:
! *dims*, *dimsizes*, *longnames*, *units*, and *xtypes*.
! Another sophisticated one has only array of type GT_HISTORY_AXIS,
! *axes*.
! Temporal definition is done without *origin*, *interval*.
!
implicit none
character(*), intent(in) :: file
! HistoryCreate 参照
! (以下 axes を除く引数も同様)
!
character(*), intent(in) :: title, source, institution
type(GT_HISTORY_AXIS), intent(in) :: axes(:)
! 次元情報を格納した構造型変数
!
! GT_HISTORY_AXIS 型変数の生成
! (constructer) は
! HistoryAxisCreate にて行いま
! す。配列の大きさに制限は
! ありません。
!
real, intent(in), optional :: origin, interval
type(GT_HISTORY), intent(out), optional:: history
character(*), intent(in), optional:: conventions, gt_version
logical, intent(in), optional:: overwrite
! 構造体 GT_HISTORY_AXIS のデータ蓄積用
character(STRING), allocatable :: axes_name(:)
integer , allocatable :: axes_length(:)
character(STRING), allocatable :: axes_longname(:)
character(STRING), allocatable :: axes_units(:)
character(STRING), allocatable :: axes_xtype(:)
integer :: 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, overwrite=overwrite)
! 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 HistoryCreate2
HistoryCreate( file, title, source, institution, dims, dimsizes, longnames, units, [origin], [interval], [xtypes], [history], [conventions], [gt_version], [overwrite] )
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)
: | 次元の名前
配列の大きさに制限はありません. 文字数は dc_types#TOKEN まで. 配列内の文字数は
全て同じでなければなりません. 足りない文字分は空白で 補ってください.
|
|
dimsizes(:) : | integer, intent (in)
: | dims で指定したそれぞれの次元 大きさ
配列の大きさは dims の 大きさと等しい必要があります. ‘0’
(数字のゼロ) を指定する とその次元は 無制限次元 (unlimited dimension)
となります. (gt4_history では時間の次元
に対して無制限次元を用いるこ とを想定しています). ただし, 1 つの NetCDF
ファイルは最大 で 1 つの無制限次元しか持てな いので, 2
ヶ所以上に’0’ を指 定しないでください. その場合, 正しく gtool4
データが出力されません.
|
|
longnames(:) : | character(len=*), intent (in)
: | dims で指定したそれぞれの次元 の名前
配列の大きさは dims の大きさ と等しい必要があります. 文字数 は dc_types#STRING まで. 配列内の文字数は
全て同じでなければなりません. 足りない文字分は空白で補います.
|
|
units(:) : | character(len=*), intent(in)
: | dims で指定したそれぞれの次元 の単位
配列の大きさは dims の大きさ と等しい必要があります. 文字数 は dc_types#STRING まで. 配列内の文字数は
全て同じでなければなりません. 足りない文字分は空白で補います.
|
|
origin : | real, intent(in), optional
: | 時間の原点
これは HistoryPut により変数
を最初に出力するときの時間と 一致します.
省略した場合, 時間の原点には 0.0 が設定されます.
|
|
interval : | real, intent(in), optional
: | 出力時間間隔
同じ変数に対して HistoryPut
を再度呼んだときに自動的に時 間変数がこの値だけ増やされて 出力されます.
なお, 各々の出 力ファイルにつき HistorySetTime を一度でも用い た場合,
この値は無効になる ので注意してください.
省略した場合, 1.0 が設定されます.
|
|
xtypes(:) : | character(len=*), intent(in), optional
: | dims で指定したそれぞれの 次元のデータ型
デフォルトは float (単精度実数型) です. 有効なのは, double (倍精度実数型),
int (整数型) です. 指定しない 場合や, 無効な型を指定した場合には, float
(単精度実数型) となります. なお, 配列の大きさ は dims
の大きさと等しい必要が あります. 配列内の文字数は全て
同じでなければなりません. 足りない文字分は空白で補います.
|
|
history : | type(GT_HISTORY), intent(out),
optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体
1 つのプログラムで複数のファイル に gtool データを出力する
場合に利用します. (単独のファイルに書き出す場合は
指定する必要は無ありません)
|
|
conventions : | character(len=*), intent(in), optional
|
gt_version : | character(len=*), intent(in), optional
|
overwrite : | logical, intent(in), optional
: | 上書き可否の設定
この引数に .false. を渡すと, 既存のファイルを上書きしません.
デフォルトは上書きします.
|
|
gtool4 データ出力用初期設定
このサブルーチンは、gtool4 データ出力の初期設定を行います。 HistoryAddVariable、 HistoryCopyVariable、 HistoryPut、 HistoryAddAttr、 HistoryClose、 HistorySetTime を用いるためには、HistoryCreate
による初期設定が必要です。
なお、プログラム内で HistoryCreate
を呼び出した場合、 プログラムを終了する前に必ず、 HistoryClose を呼び出して
終了処理を行なって下さい。
HistoryCreate
というサブルーチン名は 2 つの別々の
サブルーチンの総称名です。上記のサブルーチンも参照ください。
Two specific subroutines shares common part:
Both two ones initializes a dataset file. The result of type GT_HISTORY will be returned by
history or managed internally if omitted. Mandatory global
attributes are defined by arguments title, source, and
institution; they are all declared as ((character(len = *))).
Spatial axis definitions have two different forms: a primitive one uses
several arrays of various types: dims, dimsizes,
longnames, units, and xtypes. Another sophisticated
one has only array of type GT_HISTORY_AXIS, axes. Temporal
definition is done without origin, interval.
[Source]
subroutine HistoryCreate1(file, title, source, institution, dims, dimsizes, longnames, units, origin, interval, xtypes, history, conventions, gt_version, overwrite)
!
!== gtool4 データ出力用初期設定
!
! このサブルーチンは、gtool4 データ出力の初期設定を行います。
! HistoryAddVariable、 HistoryCopyVariable、 HistoryPut、
! HistoryAddAttr、 HistoryClose、 HistorySetTime
! を用いるためには、HistoryCreate による初期設定が必要です。
!
! なお、プログラム内で HistoryCreate を呼び出した場合、
! プログラムを終了する前に必ず、 HistoryClose を呼び出して
! 終了処理を行なって下さい。
!
! *HistoryCreate* というサブルーチン名は 2 つの別々の
! サブルーチンの総称名です。上記のサブルーチンも参照ください。
!
!
! Two specific subroutines shares common part:
!
! Both two ones initializes a dataset *file*.
! The result of type GT_HISTORY will be returned by *history*
! or managed internally if omitted.
! Mandatory global attributes are defined by arguments
! *title*, *source*, and *institution*;
! they are all declared as ((character(len = *))).
! Spatial axis definitions have two different forms:
! a primitive one uses several arrays of various types:
! *dims*, *dimsizes*, *longnames*, *units*, and *xtypes*.
! Another sophisticated one has only array of type GT_HISTORY_AXIS,
! *axes*.
! Temporal definition is done without *origin*, *interval*.
!
use gtdata_generic,only: Create, put_attr
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH
use dc_string, only: JoinChar, toChar, StoA
use dc_url, only: UrlMerge
use dc_present, only: present_and_not_empty, present_and_false
use dc_types, only: STRING, TOKEN
use dc_message, only: MessageNotify
use sysdep, only: SysdepEnvGet
use dc_date_types, only: DC_DATETIME
use dc_date, only: Create, toChar
implicit none
character(len=*), intent(in) :: file
! 出力するファイルの名前
character(len=*), intent(in) :: title
! データ全体の表題
character(len=*), intent(in) :: source
! データを作成する際の手段
character(len=*), intent(in) :: institution
! ファイルを最終的に変更した人/組織
character(len=*), intent(in) :: dims(:)
! 次元の名前
!
! 配列の大きさに制限はありません.
! 文字数は dc_types#TOKEN まで.
! 配列内の文字数は
! 全て同じでなければなりません.
! 足りない文字分は空白で
! 補ってください.
!
integer, intent (in) :: dimsizes (:)
! dims で指定したそれぞれの次元
! 大きさ
!
! 配列の大きさは dims の
! 大きさと等しい必要があります.
! '0' (数字のゼロ) を指定する
! とその次元は 無制限次元
! (unlimited dimension) となります.
! (gt4_history では時間の次元
! に対して無制限次元を用いるこ
! とを想定しています). ただし,
! 1 つの NetCDF ファイルは最大
! で 1 つの無制限次元しか持てな
! いので, 2 ヶ所以上に'0' を指
! 定しないでください. その場合,
! 正しく gtool4
! データが出力されません.
!
character(len=*), intent (in) :: longnames (:)
! dims で指定したそれぞれの次元
! の名前
!
! 配列の大きさは dims の大きさ
! と等しい必要があります. 文字数
! は dc_types#STRING まで.
! 配列内の文字数は
! 全て同じでなければなりません.
! 足りない文字分は空白で補います.
!
character(len=*), intent(in) :: units(:)
! dims で指定したそれぞれの次元
! の単位
!
! 配列の大きさは dims の大きさ
! と等しい必要があります. 文字数
! は dc_types#STRING まで.
! 配列内の文字数は
! 全て同じでなければなりません.
! 足りない文字分は空白で補います.
!
real, intent(in), optional :: origin
! 時間の原点
!
! これは HistoryPut により変数
! を最初に出力するときの時間と
! 一致します.
!
! 省略した場合, 時間の原点には
! 0.0 が設定されます.
!
real, intent(in), optional :: interval
! 出力時間間隔
!
! 同じ変数に対して HistoryPut
! を再度呼んだときに自動的に時
! 間変数がこの値だけ増やされて
! 出力されます. なお, 各々の出
! 力ファイルにつき
! HistorySetTime を一度でも用い
! た場合, この値は無効になる
! ので注意してください.
!
! 省略した場合, 1.0 が設定されます.
!
character(len=*), intent(in), optional :: xtypes(:)
! dims で指定したそれぞれの
! 次元のデータ型
!
! デフォルトは float (単精度実数型)
! です. 有効なのは,
! double (倍精度実数型), int
! (整数型) です. 指定しない
! 場合や, 無効な型を指定した場合には,
! float (単精度実数型)
! となります. なお, 配列の大きさ
! は *dims* の大きさと等しい必要が
! あります. 配列内の文字数は全て
! 同じでなければなりません.
! 足りない文字分は空白で補います.
!
type(GT_HISTORY), intent(out), optional, target:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! 1 つのプログラムで複数のファイル
! に gtool データを出力する
! 場合に利用します.
! (単独のファイルに書き出す場合は
! 指定する必要は無ありません)
!
character(len=*), intent(in), optional:: conventions
! 出力するファイルの netCDF
! 規約
!
! 省略した場合,
! もしくは空文字を与えた場合,
! 出力する netCDF 規約の
! Conventions 属性に値
! gtool4_netCDF_Conventions
! が自動的に与えられます.
!
character(len=*), intent(in), optional:: gt_version
! gtool4 netCDF 規約のバージョン
!
! 省略した場合, gt_version 属性に
! 規約の最新版のバージョンナンバー
! gtool4_netCDF_version
! が与えられます.
! (ただし, 引数 conventions に
! gtool4_netCDF_Conventions
! 以外が与えられる場合は
! gt_version 属性を作成しません).
!
logical, intent(in), optional:: overwrite
! 上書き可否の設定
!
! この引数に .false. を渡すと,
! 既存のファイルを上書きしません.
! デフォルトは上書きします.
!
integer:: numdims, i, stat
real:: origin_internal
type(GT_HISTORY), pointer:: hst =>null()
character(len = TOKEN):: my_xtype
character(len = STRING):: merged, x_inst, x_conv, x_gtver, nc_history
character(len = STRING):: cause_c
logical :: gtver_add, overwrite_required
character(len = token) :: username
type(DC_DATETIME) :: now_time
character(len = *), parameter:: subname = "HistoryCreate1"
continue
call BeginSub(subname, 'file=%c ndims=%d', c1=trim(file), i=(/size(dims)/), version=version)
call DbgMessage( 'dims(:)=%a, dimsizes(:)=%a, longnames(:)=%a, units(:)=%a', ca=StoA(JoinChar(dims), toChar(dimsizes), JoinChar(longnames), JoinChar(units)))
if (present(history)) then
hst => history
else
hst => default
endif
numdims = size(dims)
stat = DC_NOERR
cause_c = ""
if ( size(dimsizes) /= numdims ) then
cause_c = 'dimsizes, dims'
elseif ( size(longnames) /= numdims ) then
cause_c = 'longnames, dims'
elseif ( size(units) /= numdims ) then
cause_c = 'units, dims'
else
if (present(xtypes)) then
if (size(xtypes) /= numdims) then
cause_c = 'xtypes, dims'
end if
end if
endif
if ( trim(cause_c) /= "" ) then
stat = GT_EARGSIZEMISMATCH
goto 999
end if
! 次元変数表作成
allocate(hst % dimvars(numdims))
allocate(hst % dim_value_written(numdims))
hst % dim_value_written(:) = .false.
hst % unlimited_index = 0
call SysdepEnvGet('USER', username)
if (trim(username) == '') username = 'unknown'
call Create(now_time)
nc_history = trim(toChar(now_time)) // ' ' // trim(username) // '> 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))
overwrite_required = .true.
if (present_and_false(overwrite)) overwrite_required = .false.
call Create( hst % dimvars(i), trim(merged), dimsizes(i), xtype=trim(my_xtype), overwrite=overwrite_required)
! 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_and_not_empty(gt_version)) then
x_gtver = gt_version
gtver_add = .TRUE.
else
if (present_and_not_empty(conventions) .and. .not. x_conv == gtool4_netCDF_Conventions) then
gtver_add = .FALSE.
else
x_gtver = gtool4_netCDF_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)
! 時間カウンタ
if (present(interval)) then
hst % interval = interval
else
hst % interval = 1.0
call MessageNotify('M', subname, 'interval=%r in output file <%c> (auto-setting)', c1=trim(file), r=(/hst % interval/))
end if
if (present(origin)) then
origin_internal = origin
else
origin_internal = 0.0
call MessageNotify('M', subname, 'origin=%r in output file <%c> (auto-setting)', c1=trim(file), r=(/origin_internal/))
end if
hst % origin = origin_internal
hst % newest = origin_internal
hst % oldest = origin_internal
call EndSub(subname, 'std')
return
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname, 'err')
end subroutine HistoryCreate1
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
: | netCDF ファイル名. NetCDF filename.
|
|
varname : | character(*), intent(in)
|
array : | real(DP), intent(out)
: | 取得するデータを格納する配列
型は整数型, 単精度実数型, 倍精度実数型 かのいづれかです. 取得するデータの空
間次元のサイズと配列のサイズとが一致し ている必要があります. 入力するデータ
の型と array の型が異なる場合は, 自 動的に array
の型に変換されます.
Array in which input data is store
Type is integer or single precision real or double precision. Size of array
must be identical to input data size. When type of input data is different
from type of array, data is converted to type of array
automatically.
|
|
range : | character(*), intent(in), optional
: | 切り出し用オプション. gtool4 変数のコンマ記法で記述 {(例:
time=100.0,x=10:20,y=^1:^5)}
詳しくは gtool4 netCDF 規約 の「5.4
コンマ記法」を参照して ください.
数値のみが与えられる場合 (※ 引数の型 は常に文字型です. ここでの「数値」は
"10.0" のような文字列 を指します),
この値は時刻(正確には netCDF の無制限次元) の値として扱われ ます.
Option for clipping. Give gtool4 comma-graphy {(ex.
time=100.0,x=10:20,y=^1:^5)}
For details, see "5.4 gtool4 comma-graphy" in gtool4 netCDF Convention
When pure numerical value is given (Type of argument is character. In this
case, the "pure numerical value" means a character like
"10.0") the value is treated as time (to be
exact, unlimited dimension).
|
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
: | 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合,
プログラムは強制終了します. 引数 err が与えられる場合,
プログラムは強制終了せず, 代わりに err に .true. が代入されます.
Exception handling flag. By default, when error occur in this procedure,
the program aborts. If this err argument is given, .true. is
substituted to err and the program does not abort.
|
|
netCDF データを入力します. gtool4 netCDF 規約に基づくデータを想定
していますが, 大抵の netCDF データの入力は可能であると期待されます.
Input netCDF data. NetCDF data with gtool4 conventions is assumed, but most
netCDF data is expected to be input.
file にファイル名を, varname に変数名を与えます. array
にはファイルから入力されたデータが返ります.
ポインタの配列へデータを入力を行う場合は, HistoryGetPointer を利用してください.
Give filename to file, variable name to varname. Input data
is returned to array. If you want to use pointer array, use HistoryGetPointer .
デフォルトでは, ファイル内の最新データ, すなわちデータを
時刻最大で切り出したものを入力します. 別の時刻で切り出したデータを
入力したい場合には, 下記の range オプションを利用してください.
By default, recent data, that is to say, data clipped with maximum time is
input. In order to input data clipped with other time, use range
option as follows.
range には gtool4 のコンマ記法 (gtool4 netCDF 規約 の「5.4
コンマ記法」参照) を与えることで, 入力データの一部を切り出すことが可能です.
Give gtool4 comma-graphy (See "5.4 gtool4 comma-graphy" in gtool4 netCDF Convention) to
range, then input data is clipped.
HistoryGet
は複数のサブルーチンの総称名です. array には 0 ~ 7 次元の整数型,
単精度実数型, 倍精度実数型の配列を与えることが可能です.
HistoryGet is generic name of
multiple subroutines. Integer, single precision real, and double precision
0 — 7 rank array can be given to array.
デフォルトでは, データの入力時にどのファイルのどの変数が
どの次元で切り出されて入力されたのかを表示します.
メッセージ出力が不要な場合は quiet に .true. を与えてください.
By default, when data is input, filename and variable name and clipping
information is printed. The message is suppressed when .true. is given to
quiet
Original external subprogram is historyget.f90#HistoryGetDouble0
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Original external subprogram is historyget.f90#HistoryGetInt0
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Original external subprogram is historyget.f90#HistoryGetReal0
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 1 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt1
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 1 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble1
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 1 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal1
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 2 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt2
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 2 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble2
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 2 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal2
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 3 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt3
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 3 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble3
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 3 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal3
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 4 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt4
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 4 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble4
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 4 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal4
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 5 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt5
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 5 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble5
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 5 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal5
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 6 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt6
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 6 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble6
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 6 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal6
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | integer, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型固定配列用 7 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt7
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | real(DP), intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型固定配列用 7 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble7
HistoryGet( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | real, intent(out)
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型固定配列用 7 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal7
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
: | netCDF ファイル名. NetCDF filename.
|
|
varname : | character(*), intent(in)
|
array : | real(DP), pointer
: | (out)
取得するデータを格納する ポインタ配列
必ず空状態の配列を与えてください. すなわち与える配列に対し, 初期値
=>null() を設定するか nullify を用いて ください.
既に割り付けられている場合, もしくは不定状態の場合にはエラーを返し ます.
型は整数型, 単精度実数型, 倍精度実数型 かのいづれかです. 入力するデータ
の型と array の型が異なる場合は, 自 動的に array
の型に変換されます.
Array in which input data is store
Give null array to array. More specifically, use
’=>null()’ as initial value or use ‘nullify’ to
the array. If the array is allocated already, or undefined, error is
occurred.
Type is integer or single precision real or double precision. When type of
input data is different from type of array, data is converted to
type of array automatically.
|
|
range : | character(*), intent(in), optional
: | 切り出し用オプション. gtool4 変数のコンマ記法で記述 {(例:
time=100.0,x=10:20,y=^1:^5)}
詳しくは gtool4 netCDF 規約 の「5.4
コンマ記法」を参照して ください.
数値のみが与えられる場合 (※ 引数の型 は常に文字型です. ここでの「数値」は
"10.0" のような文字列 を指します),
この値は時刻(正確には netCDF の無制限次元) の値として扱われ ます.
Option for clipping. Give gtool4 comma-graphy {(ex.
time=100.0,x=10:20,y=^1:^5)}
For details, see "5.4 gtool4 comma-graphy" in gtool4 netCDF Convention
When pure numerical value is given (Type of argument is character. In this
case, the "pure numerical value" means a character like
"10.0") the value is treated as time (to be
exact, unlimited dimension).
|
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
: | 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合,
プログラムは強制終了します. 引数 err が与えられる場合,
プログラムは強制終了せず, 代わりに err に .true. が代入されます.
Exception handling flag. By default, when error occur in this procedure,
the program aborts. If this err argument is given, .true. is
substituted to err and the program does not abort.
|
|
netCDF データを入力します. gtool4 netCDF 規約に基づくデータを想定
していますが, 大抵の netCDF データの入力は可能であると期待されます.
Input netCDF data. NetCDF data with gtool4 conventions is assumed, but most
netCDF data is expected to be input.
file にファイル名を, varname に変数名を与えます. array
にはファイルから入力されたデータが返ります.
固定長の配列へデータを入力を行う場合は, HistoryGet を利用してください.
Give filename to file, variable name to varname. Input data
is returned to array. If you want to use fixed length array, use HistoryGet .
array には必ず空状態の配列を与えてください.
すなわち与える配列に対し, 初期値 =>null() を設定するか nullify
を用いてください. 既に割り付けられている場合, もしくは不定状態の場合には
エラーを返します.
Give null array to array. More specifically, use
’=>null()’ as initial value or use ‘nullify’ to
the array. If the array is allocated already, or undefined, error is
occurred.
デフォルトでは, ファイル内の最新データ, すなわちデータを
時刻最大で切り出したものを入力します. 別の時刻で切り出したデータを
入力したい場合には, 下記の range オプションを利用してください.
By default, recent data, that is to say, data clipped with maximum time is
input. In order to input data clipped with other time, use range
option as follows.
range には gtool4 のコンマ記法 (gtool4 netCDF 規約 の「5.4
コンマ記法」参照) を与えることで, 入力データの一部を切り出すことが可能です.
Give gtool4 comma-graphy (See "5.4 gtool4 comma-graphy" in gtool4 netCDF Convention) to
range, then input data is clipped.
HistoryGetPointer
は複数のサブルーチンの総称名です. array には 0 ~ 7 次元の整数型,
単精度実数型, 倍精度実数型の配列を与えることが可能です.
HistoryGetPointer is generic
name of multiple subroutines. Integer, single precision real, and double
precision 0 — 7 rank array can be given to array.
デフォルトでは, データの入力時にどのファイルのどの変数が
どの次元で切り出されて入力されたのかを表示します.
メッセージ出力が不要な場合は quiet に .true. を与えてください.
By default, when data is input, filename and variable name and clipping
information is printed. The message is suppressed when .true. is given to
quiet
Original external subprogram is historyget.f90#HistoryGetDouble0Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Original external subprogram is historyget.f90#HistoryGetInt0Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Original external subprogram is historyget.f90#HistoryGetReal0Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 1 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt1Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 1 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble1Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 1 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal1Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 2 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt2Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 2 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble2Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 2 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal2Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 3 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt3Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 3 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble3Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 3 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal3Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 4 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt4Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 4 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble4Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 4 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal4Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 5 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt5Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 5 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble5Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 5 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal5Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 6 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt6Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 6 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble6Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 6 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal6Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | integer, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Int 型ポインタ配列用 7 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetInt7Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | real(DP), pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Double 型ポインタ配列用 7 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetDouble7Pointer
HistoryGetPointer( file, varname, array, [range], [quiet], [err] )
Subroutine : |
|
file : | character(*), intent(in)
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | real, pointer
|
range : | character(*), intent(in), optional
|
quiet : | logical, intent(in), optional
|
err : | logical, intent(out), optional
|
Real 型ポインタ配列用 7 次元配列用データ入力サブルーチン
Original external subprogram is historyget.f90#HistoryGetReal7Pointer
HistoryInquire( history, [err], [file], [title], [source], [dims], [dimsizes], [longnames], [units], [xtypes], [institution], [origin], [interval], [newest], [oldest], [conventions], [gt_version], [axes], [varinfo] )
Subroutine : |
|
history : | character(*), intent(in)
|
err : | logical, intent(out), optional
|
file : | character(*), intent(out), optional
|
title : | character(*), intent(out), optional
|
source : | character(*), intent(out), optional
|
dims(:) : | character(*), pointer, optional
|
dimsizes(:) : | integer,pointer, optional
|
longnames(:) : | character(*), pointer, optional
|
units(:) : | character(*), pointer, optional
|
xtypes(:) : | character(*), pointer, optional
|
institution : | character(*), intent(out), optional
|
origin : | real,intent(out), optional
|
interval : | real,intent(out), optional
|
newest : | real,intent(out), optional
|
oldest : | real,intent(out), optional
|
conventions : | character(*), intent(out), optional
|
gt_version : | character(*), intent(out), optional
|
axes(:) : | type(GT_HISTORY_AXIS), pointer,
optional
|
varinfo(:) : | type(GT_HISTORY_VARINFO),
pointer, optional
|
HistoryCreate で history
を指定しなかった場合はこちらの サブルーチンで問い合わせを行います。
history には必ず "default"
という文字列を与えてください。
HistoryInquire は 2
つのサブルーチンの総称名です。
各引数の情報に関しては下記のサブルーチンを参照してください。
[Source]
subroutine HistoryInquire2(history, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
!
!== GT_HISTORY 型変数への問い合わせ
!
! HistoryCreate で *history* を指定しなかった場合はこちらの
! サブルーチンで問い合わせを行います。
! *history* には必ず "+default+" という文字列を与えてください。
!
! *HistoryInquire* は 2 つのサブルーチンの総称名です。
! 各引数の情報に関しては下記のサブルーチンを参照してください。
!
!
!
use dc_error, only: StoreError, DC_NOERR, NF_EINVAL
implicit none
character(*), intent(in):: history
logical, intent(out), optional :: err
character(*), intent(out), optional:: file, title, source, institution
real,intent(out), optional:: origin, interval, newest, oldest
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:) ! (out)
integer,pointer, optional:: dimsizes(:) ! (out)
character(*), pointer, optional:: longnames(:) ! (out)
character(*), pointer, optional:: units(:) ! (out)
character(*), pointer, optional:: xtypes(:) ! (out)
type(GT_HISTORY_AXIS), pointer, optional :: axes(:) ! (out)
type(GT_HISTORY_VARINFO), pointer, optional :: varinfo(:) ! (out)
integer :: 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, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryInquire2
HistoryInquire( history, [err], [file], [title], [source], [dims], [dimsizes], [longnames], [units], [xtypes], [institution], [origin], [interval], [newest], [oldest], [conventions], [gt_version], [axes], [varinfo] )
Subroutine : |
|
history : | type(GT_HISTORY),
intent(in)
|
err : | logical, intent(out), optional
|
file : | character(*), intent(out), optional
|
title : | character(*), intent(out), optional
|
source : | character(*), intent(out), optional
|
dims(:) : | character(*), pointer, optional
|
dimsizes(:) : | integer,pointer, optional
|
longnames(:) : | character(*), pointer, optional
|
units(:) : | character(*), pointer, optional
|
xtypes(:) : | character(*), pointer, optional
|
institution : | character(*), intent(out), optional
|
origin : | real,intent(out), optional
|
interval : | real,intent(out), optional
|
newest : | real,intent(out), optional
|
oldest : | real,intent(out), optional
|
conventions : | character(*), intent(out), optional
|
gt_version : | character(*), intent(out), optional
|
axes(:) : | type(GT_HISTORY_AXIS), pointer,
optional
|
varinfo(:) : | type(GT_HISTORY_VARINFO),
pointer, optional
|
HistoryCreate や HistoryAddVariable などで設定した値の
参照を行います。
file, title, source, institution, origin, interval, conventions,
gt_version, dims, dimsizes, longnames, units, xtypes に関しては HistoryCreate を参照してください。
title, source, institution, origin, interval, conventions, gt_version
に関しては、値が得られなかった場合は "unknown" が返ります。
dims, dimsizes, longnames, units, xtypes に関してはポインタに
値を返すため、必ずポインタを空状態にしてから与えてください。
axes と varinfo にはそれぞれ座標軸情報と変数情報を返します。
将来的には全ての属性の値も一緒に返す予定ですが、現在は long_name, units,
xtype のみが属性の値として返ります。
HistoryInquire は 2
つのサブルーチンの総称名です。 HistoryCreate で history
を与えなかった場合の問い合わせに関しては
上記のサブルーチンを参照してください。
エラー
以下の場合に、このサブルーチンはエラーを生じプログラムを終了させます。
ただし、err 引数を与える場合、この引数に .true. を
返し、プログラムは続行します。
[Source]
subroutine HistoryInquire1(history, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
!
!== GT_HISTORY 型変数への問い合わせ
!
! HistoryCreate や HistoryAddVariable などで設定した値の
! 参照を行います。
!
! file, title, source, institution, origin, interval,
! conventions, gt_version, dims, dimsizes, longnames, units,
! xtypes に関しては HistoryCreate を参照してください。
!
! title, source, institution, origin, interval, conventions, gt_version
! に関しては、値が得られなかった場合は "unknown" が返ります。
!
! dims, dimsizes, longnames, units, xtypes に関してはポインタに
! 値を返すため、必ずポインタを空状態にしてから与えてください。
!
! axes と varinfo にはそれぞれ座標軸情報と変数情報を返します。
! 将来的には全ての属性の値も一緒に返す予定ですが、現在は
! long_name, units, xtype のみが属性の値として返ります。
!
! *HistoryInquire* は 2 つのサブルーチンの総称名です。
! HistoryCreate で *history* を与えなかった場合の問い合わせに関しては
! 上記のサブルーチンを参照してください。
!
!=== エラー
!
! 以下の場合に、このサブルーチンはエラーを生じプログラムを終了させます。
! ただし、*err* 引数を与える場合、この引数に <tt>.true.</tt> を
! 返し、プログラムは続行します。
!
! - *history* が HistoryCreate によって初期設定されていない場合
! - HistoryAddVariable や HistoryCopyVariable 等による変数定義が
! 一度も行われていない GT_HISTORY 変数に対して引数 varinfo
! を渡した場合
!
use dc_error, only: StoreError, DC_NOERR, GT_EBADHISTORY, NF_ENOTVAR
use gtdata_generic, only: Inquire, Get_Attr, Open, Close
use dc_url, only: UrlSplit
implicit none
type(GT_HISTORY), intent(in):: history
logical, intent(out), optional :: err
character(*), intent(out), optional:: file, title, source, institution
real,intent(out), optional:: origin, interval
real,intent(out), optional:: newest ! 最新の時刻
real,intent(out), optional:: oldest ! 最初の時刻
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:) ! (out)
integer,pointer, optional:: dimsizes(:) ! (out)
character(*), pointer, optional:: longnames(:) ! (out)
character(*), pointer, optional:: units(:) ! (out)
character(*), pointer, optional:: xtypes(:) ! (out)
type(GT_HISTORY_AXIS), pointer, optional :: axes(:) ! (out)
type(GT_HISTORY_VARINFO), pointer, optional :: varinfo(:) ! (out)
! Internal Work
character(STRING) :: url, cause_c
character(TOKEN) :: unknown_mes = 'unknown'
integer :: i, j, numdims, numvars, alldims, stat
logical :: growable
type(GT_VARIABLE) :: dimvar
character(*), parameter:: subname = "HistoryInquire1"
continue
call BeginSub(subname)
stat = DC_NOERR
cause_c = ''
if (.not. associated(history % dimvars) .or. size(history % dimvars) < 1) then
stat = GT_EBADHISTORY
goto 999
end if
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, trim(unknown_mes))
end if
if (present(source)) then
call Get_Attr(history % dimvars(1), '+source', source, trim(unknown_mes))
end if
if (present(institution)) then
call Get_Attr(history % dimvars(1), '+institution', institution, trim(unknown_mes))
end if
if (present(origin)) then
origin = history % origin
end if
if (present(interval)) then
interval = history % interval
end if
if (present(newest)) then
newest = history % newest
end if
if (present(oldest)) then
oldest = history % oldest
end if
if (present(conventions)) then
call Get_Attr(history % dimvars(1), '+Conventions', conventions, trim(unknown_mes))
end if
if (present(gt_version)) then
call Get_Attr(history % dimvars(1), '+gt_version', gt_version, trim(unknown_mes))
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
if (present(axes)) then
numvars = size(history % dimvars)
allocate(axes(numvars))
do i = 1, numvars
call Inquire(history % dimvars(i), allcount=axes(i) % length, xtype=axes(i) % xtype, name=axes(i) % name)
call Get_Attr(history % dimvars(i), 'long_name', axes(i) % longname, 'unknown')
call Get_Attr(history % dimvars(i), 'units', axes(i) % units, 'unknown')
! 属性 GT_HISTORY_ATTR はまだ取得できない
!
! するためには, 属性名に対して様々な型が存在しうると
! 考えられるため, get_attr (gtdata_generic および an_generic)
! に err 属性を装備させ, 取得できない際にエラーを
! 返してもらわなければならないだろう.
end do
end if
if (present(varinfo)) then
if (.not. associated(history % vars) .or. size(history % vars) < 1) then
stat = NF_ENOTVAR
goto 999
end if
numvars = size(history % vars)
allocate(varinfo(numvars))
do i = 1, numvars
call Inquire(history % vars(i), alldims=alldims, xtype=varinfo(i) % xtype, name=varinfo(i) % name)
call Get_Attr(history % vars(i), 'long_name', varinfo(i) % longname, 'unknown')
call Get_Attr(history % vars(i), 'units', varinfo(i) % units, 'unknown')
! 属性 GT_HISTORY_ATTR はまだ取得できない
!
! するためには, 属性名に対して様々な型が存在しうると
! 考えられるため, get_attr (gtdata_generic および an_generic)
! に err 属性を装備させ, 取得できない際にエラーを
! 返してもらわなければならないだろう.
allocate(varinfo(i) % dims(alldims))
do j = 1, alldims
call Open(var=dimvar, source_var=history % vars(i), dimord=j, count_compact=.true.)
call Inquire(dimvar, name=varinfo(i) % dims(j))
call Close(dimvar)
end do
end do
end if
999 continue
call StoreError(stat, subname, err, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryInquire1
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:) : | real(DP), intent(in)
: | 変数が出力するデータ
型は単精度実数型でも 倍精度実数型でもよいですが、 HistoryAddVariable の xtype
で指定した データ型と異なる 型を渡した場合、xtype で
指定した型に変換されます。
|
|
history : | type(GT_HISTORY), intent(inout),
optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体
ここに指定するものは、 HistoryCreate
によって初期設定 されていなければなりません。
|
|
range : | character(*), intent(in), optional
|
データ出力
gtool4 データ内の変数へデータの出力を行います。
このサブルーチンを用いる前に、HistoryCreate
による初期設定が必要です。
HistoryPut
は複数のサブルーチンの総称名です。array には 0 ~ 7
次元のデータを与えることが可能です。 (下記のサブルーチンを参照ください)。
ただし、0 次元のデータを与える際の引数キーワードは value
を用いてください。
HistoryPut
を最初に呼んだ時、時間次元の変数は HistoryCreate の origin
の値に設定されます。
ある変数 varname に対して HistoryPut
を複数回呼ぶと、 HistoryCreate の
interval × HistoryPut
を呼んだ回数、 の分だけ 時間次元の変数の値が増やされます。
これらの時間次元の変数の値を明示的に設定したい場合は HistorySetTime を用いるか、HistoryPut 自身で時間次元の変数へ値
を出力してください。
[Source]
subroutine HistoryPutDouble1(varname, array, history, range)
!
!
!== データ出力
!
! gtool4 データ内の変数へデータの出力を行います。
! このサブルーチンを用いる前に、HistoryCreate
! による初期設定が必要です。
!
! *HistoryPut* は複数のサブルーチンの総称名です。*array* には
! 0 ~ 7 次元のデータを与えることが可能です。
! (下記のサブルーチンを参照ください)。
! ただし、0 次元のデータを与える際の引数キーワードは
! *value* を用いてください。
!
! HistoryPut を最初に呼んだ時、時間次元の変数は HistoryCreate の
! origin の値に設定されます。
!
! ある変数 varname に対して HistoryPut を複数回呼ぶと、
! HistoryCreate の interval × HistoryPut を呼んだ回数、 の分だけ
! 時間次元の変数の値が増やされます。
!
! これらの時間次元の変数の値を明示的に設定したい場合は
! HistorySetTime を用いるか、HistoryPut 自身で時間次元の変数へ値
! を出力してください。
!
!
character(*), intent(in):: varname
! 変数の名前
!
! ただし、ここで指定するもの
! は、 HistoryCreateの *dims*
! または HistoryAddVariable や
! HistoryCopyVariable の
! *varname* で既に指定されてい
! なければなりません。
!
real(DP), intent(in):: array(:)
! 変数が出力するデータ
!
! 型は単精度実数型でも
! 倍精度実数型でもよいですが、
! HistoryAddVariable の
! *xtype* で指定した
! データ型と異なる
! 型を渡した場合、xtype で
! 指定した型に変換されます。
!
type(GT_HISTORY), intent(inout), optional, target:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
character(*), intent(in), optional:: range
! gtool4 のコンマ記法による
! データの出力範囲指定
!
! このオプションを用いる
! 際には、必ず *HistorySetTime*
! によって明示的に時刻の設定
! を行ってください。
! また、*HistoryGet* と異なり、
! 時刻に関する範囲指定は
! 行なえません。
!
! 書式に関する詳細は
! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
! の「5.4 コンマ記法」を参照して
! ください。
character(*), parameter:: subname = "HistoryPutDouble1"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt1(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt1"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal1(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal1"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt2(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt2"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble2(varname, array, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble2"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal2(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal2"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt3(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt3"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble3(varname, array, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble3"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal3(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal3"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt4(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt4"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble4(varname, array, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble4"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal4(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal4"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt5(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt5"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble5(varname, array, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble5"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal5(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal5"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt6(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt6"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble6(varname, array, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble6"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal6(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal6"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt7(varname, array, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt7"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble7(varname, array, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble7"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
array(:,:,:,:,:,:,:) : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal7(varname, array, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: array(:,:,:,:,:,:,:)
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal7"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, array, size(array), history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
value : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutInt0(varname, value, history, range)
!
!
character(*), intent(in):: varname
integer, intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutInt0"
continue
call BeginSub(subname)
call HistoryPutIntEx(varname, (/value/), 1, history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
value : | real(DP), intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutDouble0(varname, value, history, range)
!
!
character(*), intent(in):: varname
real(DP), intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutDouble0"
continue
call BeginSub(subname)
call HistoryPutDoubleEx(varname, (/value/), 1, history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(*), intent(in)
|
value : | real, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional, target
|
range : | character(*), intent(in), optional
|
[Source]
subroutine HistoryPutReal0(varname, value, history, range)
!
!
character(*), intent(in):: varname
real, intent(in):: value
type(GT_HISTORY), intent(inout), optional, target:: history
character(*), intent(in), optional:: range
character(*), parameter:: subname = "HistoryPutReal0"
continue
call BeginSub(subname)
call HistoryPutRealEx(varname, (/value/), 1, history, range)
call EndSub(subname)
end subroutine
Subroutine : |
|
varname : | character(len = *), intent(in)
|
array(arraysize) : | integer, intent(in)
|
arraysize : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional
|
range : | character(*), intent(in), optional
|
データ出力
こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。
[Source]
subroutine HistoryPutIntEx(varname, array, arraysize, history, range)
!
!== データ出力
!
! こちらは配列サイズを指定する必要があるため、
! HistoryPut を利用してください。
!
use gtdata_generic, only: Put, GTVarSync, Slice, Inquire, Get_Slice
use dc_string, only: StoA, Printf, toChar, JoinChar
use dc_present, only: present_and_not_empty, present_select
use dc_error, only: StoreError
character(len = *), intent(in):: varname
integer, intent(in):: arraysize
integer, intent(in):: array(arraysize)
type(GT_HISTORY), intent(inout), optional:: history
character(*), intent(in), optional:: range
! gtool4 のコンマ記法による
! データの出力範囲指定
!
! このオプションを用いる
! 際には、必ず *HistorySetTime*
! によって明示的に時刻の設定
! を行ってください。
! また、*HistoryGet* と異なり、
! 時刻に関する範囲指定は
! 行なえません。
!
! 書式に関する詳細は
! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
! の「5.4 コンマ記法」を参照して
! ください。
type(GT_VARIABLE):: var
integer, allocatable:: start(:), count(:), stride(:)
integer :: i, dims
logical :: slice_err
character(*), parameter:: subname = "HistoryPutIntEx"
continue
call BeginSub(subname, 'varname=%a range=%a', ca=StoA(varname, present_select('', '(no-range)', range)))
call TimeGoAhead(varname, var, real(array(1)), history)
call Inquire(var, alldims=dims)
if (present_and_not_empty(range) .and. (dims < 1)) then
call DbgMessage('varname=<%c> has no dimension. so range is ignoread.', c1=trim(varname))
end if
if (.not. (present_and_not_empty(range) .and. (dims > 0))) then
! range 無しの普通の出力の場合
call Put(var, array, arraysize)
else
! range があり, 且つ varname がちゃんと次元を持っている場合
!
! 元々の start, count, stride を保持. データを与えた後に復元する.
allocate(start(dims), count(dims), stride(dims))
do i = 1, dims
call Get_Slice(var, i, start(i), count(i), stride(i))
end do
slice_err = .false. ! 不要だが Slice の引用仕様として必要なため
call Slice(var, range, slice_err)
call Put(var, array, arraysize)
! 復元
do i = 1, dims
call Slice(var, i, start(i), count(i), stride(i))
end do
deallocate(start, count, stride)
end if
call GTVarSync(var)
call EndSub(subname)
end subroutine HistoryPutIntEx
Subroutine : |
|
varname : | character(len = *), intent(in)
|
array(arraysize) : | real(DP), intent(in)
|
arraysize : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional
|
range : | character(*), intent(in), optional
|
データ出力
こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。
[Source]
subroutine HistoryPutDoubleEx(varname, array, arraysize, history, range)
!
!== データ出力
!
! こちらは配列サイズを指定する必要があるため、
! HistoryPut を利用してください。
!
use gtdata_generic, only: Put, GTVarSync, Slice, Inquire, Get_Slice
use dc_string, only: StoA, Printf, toChar, JoinChar
use dc_present, only: present_and_not_empty, present_select
use dc_error, only: StoreError
character(len = *), intent(in):: varname
integer, intent(in):: arraysize
real(DP), intent(in):: array(arraysize)
type(GT_HISTORY), intent(inout), optional:: history
character(*), intent(in), optional:: range
! gtool4 のコンマ記法による
! データの出力範囲指定
!
! このオプションを用いる
! 際には、必ず *HistorySetTime*
! によって明示的に時刻の設定
! を行ってください。
! また、*HistoryGet* と異なり、
! 時刻に関する範囲指定は
! 行なえません。
!
! 書式に関する詳細は
! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
! の「5.4 コンマ記法」を参照して
! ください。
type(GT_VARIABLE):: var
integer, allocatable:: start(:), count(:), stride(:)
integer :: i, dims
logical :: slice_err
character(*), parameter:: subname = "HistoryPutDoubleEx"
continue
call BeginSub(subname, 'varname=%a range=%a', ca=StoA(varname, present_select('', '(no-range)', range)))
call TimeGoAhead(varname, var, real(array(1)), history)
call Inquire(var, alldims=dims)
if (present_and_not_empty(range) .and. (dims < 1)) then
call DbgMessage('varname=<%c> has no dimension. so range is ignoread.', c1=trim(varname))
end if
if (.not. (present_and_not_empty(range) .and. (dims > 0))) then
! range 無しの普通の出力の場合
call Put(var, array, arraysize)
else
! range があり, 且つ varname がちゃんと次元を持っている場合
!
! 元々の start, count, stride を保持. データを与えた後に復元する.
allocate(start(dims), count(dims), stride(dims))
do i = 1, dims
call Get_Slice(var, i, start(i), count(i), stride(i))
end do
slice_err = .false. ! 不要だが Slice の引用仕様として必要なため
call Slice(var, range, slice_err)
call Put(var, array, arraysize)
! 復元
do i = 1, dims
call Slice(var, i, start(i), count(i), stride(i))
end do
deallocate(start, count, stride)
end if
call GTVarSync(var)
call EndSub(subname)
end subroutine HistoryPutDoubleEx
Subroutine : |
|
varname : | character(len = *), intent(in)
|
array(arraysize) : | real, intent(in)
|
arraysize : | integer, intent(in)
|
history : | type(GT_HISTORY), intent(inout),
optional
|
range : | character(*), intent(in), optional
|
データ出力
こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。
[Source]
subroutine HistoryPutRealEx(varname, array, arraysize, history, range)
!
!== データ出力
!
! こちらは配列サイズを指定する必要があるため、
! HistoryPut を利用してください。
!
use gtdata_generic, only: Put, GTVarSync, Slice, Inquire, Get_Slice
use dc_string, only: StoA, Printf, toChar, JoinChar
use dc_present, only: present_and_not_empty, present_select
use dc_error, only: StoreError
character(len = *), intent(in):: varname
integer, intent(in):: arraysize
real, intent(in):: array(arraysize)
type(GT_HISTORY), intent(inout), optional:: history
character(*), intent(in), optional:: range
! gtool4 のコンマ記法による
! データの出力範囲指定
!
! このオプションを用いる
! 際には、必ず *HistorySetTime*
! によって明示的に時刻の設定
! を行ってください。
! また、*HistoryGet* と異なり、
! 時刻に関する範囲指定は
! 行なえません。
!
! 書式に関する詳細は
! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
! の「5.4 コンマ記法」を参照して
! ください。
type(GT_VARIABLE):: var
integer, allocatable:: start(:), count(:), stride(:)
integer :: i, dims
logical :: slice_err
character(*), parameter:: subname = "HistoryPutRealEx"
continue
call BeginSub(subname, 'varname=%a range=%a', ca=StoA(varname, present_select('', '(no-range)', range)))
call TimeGoAhead(varname, var, real(array(1)), history)
call Inquire(var, alldims=dims)
if (present_and_not_empty(range) .and. (dims < 1)) then
call DbgMessage('varname=<%c> has no dimension. so range is ignoread.', c1=trim(varname))
end if
if (.not. (present_and_not_empty(range) .and. (dims > 0))) then
! range 無しの普通の出力の場合
call Put(var, array, arraysize)
else
! range があり, 且つ varname がちゃんと次元を持っている場合
!
! 元々の start, count, stride を保持. データを与えた後に復元する.
allocate(start(dims), count(dims), stride(dims))
do i = 1, dims
call Get_Slice(var, i, start(i), count(i), stride(i))
end do
slice_err = .false. ! 不要だが Slice の引用仕様として必要なため
call Slice(var, range, slice_err)
call Put(var, array, arraysize)
! 復元
do i = 1, dims
call Slice(var, i, start(i), count(i), stride(i))
end do
deallocate(start, count, stride)
end if
call GTVarSync(var)
call EndSub(subname)
end subroutine HistoryPutRealEx
Subroutine : |
|
time : | real, intent(in)
: | 時刻
ここで言う "時刻" とは、 HistoryCreate の dims で
"0" と指定されたものです。 もしも時刻が定義されていな い場合は、
このサブルーチン は何の効果も及ぼしません。
|
|
history : | type(GT_HISTORY), intent(inout),
optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体
ここに指定するものは、 HistoryCreate
によって初期設定 されていなければなりません。
|
|
時刻指定
明示的に時刻指定を行なうためのサブルーチンです。
このサブルーチンを用いる前に、HistoryCreate
による初期設定が必要です。 このサブルーチンを使用する事で HistoryCreate の interval が無効
になるので注意してください。
[Source]
subroutine HistorySetTime(time, history)
!
!== 時刻指定
!
! 明示的に時刻指定を行なうためのサブルーチンです。
! このサブルーチンを用いる前に、HistoryCreate による初期設定が必要です。
! このサブルーチンを使用する事で HistoryCreate の *interval* が無効
! になるので注意してください。
!
!
!
use gtdata_generic, only: Slice, Put, Get
implicit none
real, intent(in):: time
! 時刻
!
! ここで言う "時刻" とは、
! HistoryCreate の *dims* で "0"
! と指定されたものです。
! もしも時刻が定義されていな
! い場合は、 このサブルーチン
! は何の効果も及ぼしません。
!
type(GT_HISTORY), intent(inout), optional, target:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体
!
! ここに指定するものは、
! HistoryCreate によって初期設定
! されていなければなりません。
!
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 HistorySetTime
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | character(*), intent(in)
: | 属性に与えられる値
配列の場合でも、数値型以外 では配列の 1 つ目の要素のみ
値として付加されます。
|
|
GT_HISTORY_VARINFO 型の変数
varinfo へ属性を付加します。
HistoryVarinfoAddAttr
は複数のサブルーチンの総称名です。 value
には様々な型の引数を与えることが可能です。
下記のサブルーチンを参照ください。
[Source]
subroutine HistoryVarinfoAddAttrChar0( varinfo, attrname, value)
!
!
!== GT_HISTORY_VARINFO 型変数への属性付加
!
! GT_HISTORY_VARINFO 型の変数 *varinfo* へ属性を付加します。
!
! *HistoryVarinfoAddAttr* は複数のサブルーチンの総称名です。
! value には様々な型の引数を与えることが可能です。
! 下記のサブルーチンを参照ください。
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
character(*), intent(in):: value
! 属性に与えられる値
!
! 配列の場合でも、数値型以外
! では配列の 1 つ目の要素のみ
! 値として付加されます。
!
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | integer, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrInt0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | logical, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrLogical0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real(DP), intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrDouble0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrReal0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | integer, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrInt1( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real(DP), intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrDouble1( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrReal1( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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 で与えられた変数を HistoryVarinfoCreate
による初期設定よりも さらに前の状態に初期化します。
Destructor of GT_HISTORY_VARINFO
[Source]
subroutine HistoryVarinfoClear(varinfo)
!
!== GT_HISTORY_VARINFO 型変数初期化
!
! *varinfo* で与えられた変数を HistoryVarinfoCreate による初期設定よりも
! さらに前の状態に初期化します。
!
! Destructor of GT_HISTORY_VARINFO
!
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(len = *), parameter:: subname = "HistoryVarinfoClear1"
call BeginSub(subname)
varinfo % name = ""
varinfo % longname = ""
varinfo % units = ""
varinfo % xtype = ""
if (associated(varinfo % attrs)) then
deallocate(varinfo % attrs)
end if
call EndSub(subname)
end subroutine HistoryVarinfoClear
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
|
GT_HISTORY_VARINFO 型の変数
varinfo_src を varinfo_dest にコピーします。
varinfo_src は HistoryVarinfoCreate
によって初期設定されている必要が あります。 さらに属性を付加する場合には HistoryVarinfoAddAttr
を用いてください。
err を与えておくと、コピーの際何らかの不具合が生じても 終了せずに
err が真になって返ります。
err 以降の引数は、コピーの際に上書きする値です。
[Source]
subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err, name, dims, longname, units, xtype)
!
!== GT_HISTORY_VARINFO 型変数コピー
!
! GT_HISTORY_VARINFO 型の変数 *varinfo_src* を
! *varinfo_dest* にコピーします。
! *varinfo_src* は HistoryVarinfoCreate によって初期設定されている必要が
! あります。
! さらに属性を付加する場合には HistoryVarinfoAddAttr
! を用いてください。
!
! *err* を与えておくと、コピーの際何らかの不具合が生じても
! 終了せずに err が真になって返ります。
!
! *err* 以降の引数は、コピーの際に上書きする値です。
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_present,only: present_select
use dc_string, only: JoinChar
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 :: 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
call DbgMessage('srcdims=<%c>', c1=trim(JoinChar(srcdims)))
allocate( varinfo_dest % dims( size( srcdims ) ) )
do i = 1, size(srcdims)
varinfo_dest % dims(i) = srcdims(i)
end do
call DbgMessage('varinfo_dest %% dims=<%c>', c1=trim(JoinChar(varinfo_dest % dims)))
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
Subroutine : |
|
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)
|
GT_HISTORY_VARINFO
型変数を作成します。 このサブルーチンによる設定の後、 HistoryAddVariable の varinfo
に与えます。 さらに属性を付加する場合には HistoryVarinfoAddAttr
を用いてください。
Constructor of GT_HISTORY_VARINFO
[Source]
subroutine HistoryVarinfoCreate1( varinfo, name, dims, longname, units, xtype)
!
!== GT_HISTORY_VARINFO 型変数作成
!
! GT_HISTORY_VARINFO 型変数を作成します。
! このサブルーチンによる設定の後、
! HistoryAddVariable の *varinfo* に与えます。
! さらに属性を付加する場合には HistoryVarinfoAddAttr
! を用いてください。
!
! Constructor of GT_HISTORY_VARINFO
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_message, only: MessageNotify
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:: 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
Subroutine : |
|
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
|
GT_HISTORY_VARINFO
型の変数内の各情報を参照します。
dims はポインタ配列です。空状態にして与えてください。
[Source]
subroutine HistoryVarinfoInquire1( varinfo, name, dims, longname, units, xtype)
!
!== GT_HISTORY_VARINFO 型変数への問い合わせ
!
! GT_HISTORY_VARINFO 型の変数内の各情報を参照します。
!
! dims はポインタ配列です。空状態にして与えてください。
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
implicit none
type(GT_HISTORY_VARINFO),intent(in) :: varinfo
character(*), intent(out), optional:: name ! 次元変数名
character(*), pointer, optional:: dims(:) !(out) 依存する次元
character(*), intent(out), optional:: longname ! 次元変数の記述的名称
character(*), intent(out), optional:: units ! 次元変数の単位
character(*), intent(out), optional:: xtype ! 次元変数の型
! Internal Work
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(in)
|
name : | character(*) , intent(out), optional
|
size : | integer, intent(out), optional
|
longname : | character(*) , intent(out), optional
|
units : | character(*) , intent(out), optional
|
xtype : | character(*) , intent(out), optional
|
GT_HISTORY_AXIS
型の変数内の各情報を参照します。
[Source]
subroutine HistoryAxisInquire1( axis, name, size, longname, units, xtype)
!
!== GT_HISTORY_AXIS 型変数への問い合わせ
!
! GT_HISTORY_AXIS 型の変数内の各情報を参照します。
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
implicit none
type(GT_HISTORY_AXIS),intent(in) :: axis
character(*) , intent(out), optional:: name ! 次元変数名
integer, 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
Inquire( history, [err], [file], [title], [source], [dims], [dimsizes], [longnames], [units], [xtypes], [institution], [origin], [interval], [newest], [oldest], [conventions], [gt_version], [axes], [varinfo] )
Subroutine : |
|
history : | character(*), intent(in)
|
err : | logical, intent(out), optional
|
file : | character(*), intent(out), optional
|
title : | character(*), intent(out), optional
|
source : | character(*), intent(out), optional
|
dims(:) : | character(*), pointer, optional
|
dimsizes(:) : | integer,pointer, optional
|
longnames(:) : | character(*), pointer, optional
|
units(:) : | character(*), pointer, optional
|
xtypes(:) : | character(*), pointer, optional
|
institution : | character(*), intent(out), optional
|
origin : | real,intent(out), optional
|
interval : | real,intent(out), optional
|
newest : | real,intent(out), optional
|
oldest : | real,intent(out), optional
|
conventions : | character(*), intent(out), optional
|
gt_version : | character(*), intent(out), optional
|
axes(:) : | type(GT_HISTORY_AXIS), pointer,
optional
|
varinfo(:) : | type(GT_HISTORY_VARINFO),
pointer, optional
|
HistoryCreate で history
を指定しなかった場合はこちらの サブルーチンで問い合わせを行います。
history には必ず "default"
という文字列を与えてください。
HistoryInquire は 2
つのサブルーチンの総称名です。
各引数の情報に関しては下記のサブルーチンを参照してください。
[Source]
subroutine HistoryInquire2(history, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
!
!== GT_HISTORY 型変数への問い合わせ
!
! HistoryCreate で *history* を指定しなかった場合はこちらの
! サブルーチンで問い合わせを行います。
! *history* には必ず "+default+" という文字列を与えてください。
!
! *HistoryInquire* は 2 つのサブルーチンの総称名です。
! 各引数の情報に関しては下記のサブルーチンを参照してください。
!
!
!
use dc_error, only: StoreError, DC_NOERR, NF_EINVAL
implicit none
character(*), intent(in):: history
logical, intent(out), optional :: err
character(*), intent(out), optional:: file, title, source, institution
real,intent(out), optional:: origin, interval, newest, oldest
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:) ! (out)
integer,pointer, optional:: dimsizes(:) ! (out)
character(*), pointer, optional:: longnames(:) ! (out)
character(*), pointer, optional:: units(:) ! (out)
character(*), pointer, optional:: xtypes(:) ! (out)
type(GT_HISTORY_AXIS), pointer, optional :: axes(:) ! (out)
type(GT_HISTORY_VARINFO), pointer, optional :: varinfo(:) ! (out)
integer :: 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, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryInquire2
Inquire( history, [err], [file], [title], [source], [dims], [dimsizes], [longnames], [units], [xtypes], [institution], [origin], [interval], [newest], [oldest], [conventions], [gt_version], [axes], [varinfo] )
Subroutine : |
|
history : | type(GT_HISTORY),
intent(in)
|
err : | logical, intent(out), optional
|
file : | character(*), intent(out), optional
|
title : | character(*), intent(out), optional
|
source : | character(*), intent(out), optional
|
dims(:) : | character(*), pointer, optional
|
dimsizes(:) : | integer,pointer, optional
|
longnames(:) : | character(*), pointer, optional
|
units(:) : | character(*), pointer, optional
|
xtypes(:) : | character(*), pointer, optional
|
institution : | character(*), intent(out), optional
|
origin : | real,intent(out), optional
|
interval : | real,intent(out), optional
|
newest : | real,intent(out), optional
|
oldest : | real,intent(out), optional
|
conventions : | character(*), intent(out), optional
|
gt_version : | character(*), intent(out), optional
|
axes(:) : | type(GT_HISTORY_AXIS), pointer,
optional
|
varinfo(:) : | type(GT_HISTORY_VARINFO),
pointer, optional
|
HistoryCreate や HistoryAddVariable などで設定した値の
参照を行います。
file, title, source, institution, origin, interval, conventions,
gt_version, dims, dimsizes, longnames, units, xtypes に関しては HistoryCreate を参照してください。
title, source, institution, origin, interval, conventions, gt_version
に関しては、値が得られなかった場合は "unknown" が返ります。
dims, dimsizes, longnames, units, xtypes に関してはポインタに
値を返すため、必ずポインタを空状態にしてから与えてください。
axes と varinfo にはそれぞれ座標軸情報と変数情報を返します。
将来的には全ての属性の値も一緒に返す予定ですが、現在は long_name, units,
xtype のみが属性の値として返ります。
HistoryInquire は 2
つのサブルーチンの総称名です。 HistoryCreate で history
を与えなかった場合の問い合わせに関しては
上記のサブルーチンを参照してください。
エラー
以下の場合に、このサブルーチンはエラーを生じプログラムを終了させます。
ただし、err 引数を与える場合、この引数に .true. を
返し、プログラムは続行します。
[Source]
subroutine HistoryInquire1(history, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
!
!== GT_HISTORY 型変数への問い合わせ
!
! HistoryCreate や HistoryAddVariable などで設定した値の
! 参照を行います。
!
! file, title, source, institution, origin, interval,
! conventions, gt_version, dims, dimsizes, longnames, units,
! xtypes に関しては HistoryCreate を参照してください。
!
! title, source, institution, origin, interval, conventions, gt_version
! に関しては、値が得られなかった場合は "unknown" が返ります。
!
! dims, dimsizes, longnames, units, xtypes に関してはポインタに
! 値を返すため、必ずポインタを空状態にしてから与えてください。
!
! axes と varinfo にはそれぞれ座標軸情報と変数情報を返します。
! 将来的には全ての属性の値も一緒に返す予定ですが、現在は
! long_name, units, xtype のみが属性の値として返ります。
!
! *HistoryInquire* は 2 つのサブルーチンの総称名です。
! HistoryCreate で *history* を与えなかった場合の問い合わせに関しては
! 上記のサブルーチンを参照してください。
!
!=== エラー
!
! 以下の場合に、このサブルーチンはエラーを生じプログラムを終了させます。
! ただし、*err* 引数を与える場合、この引数に <tt>.true.</tt> を
! 返し、プログラムは続行します。
!
! - *history* が HistoryCreate によって初期設定されていない場合
! - HistoryAddVariable や HistoryCopyVariable 等による変数定義が
! 一度も行われていない GT_HISTORY 変数に対して引数 varinfo
! を渡した場合
!
use dc_error, only: StoreError, DC_NOERR, GT_EBADHISTORY, NF_ENOTVAR
use gtdata_generic, only: Inquire, Get_Attr, Open, Close
use dc_url, only: UrlSplit
implicit none
type(GT_HISTORY), intent(in):: history
logical, intent(out), optional :: err
character(*), intent(out), optional:: file, title, source, institution
real,intent(out), optional:: origin, interval
real,intent(out), optional:: newest ! 最新の時刻
real,intent(out), optional:: oldest ! 最初の時刻
character(*), intent(out), optional:: conventions, gt_version
character(*), pointer, optional:: dims(:) ! (out)
integer,pointer, optional:: dimsizes(:) ! (out)
character(*), pointer, optional:: longnames(:) ! (out)
character(*), pointer, optional:: units(:) ! (out)
character(*), pointer, optional:: xtypes(:) ! (out)
type(GT_HISTORY_AXIS), pointer, optional :: axes(:) ! (out)
type(GT_HISTORY_VARINFO), pointer, optional :: varinfo(:) ! (out)
! Internal Work
character(STRING) :: url, cause_c
character(TOKEN) :: unknown_mes = 'unknown'
integer :: i, j, numdims, numvars, alldims, stat
logical :: growable
type(GT_VARIABLE) :: dimvar
character(*), parameter:: subname = "HistoryInquire1"
continue
call BeginSub(subname)
stat = DC_NOERR
cause_c = ''
if (.not. associated(history % dimvars) .or. size(history % dimvars) < 1) then
stat = GT_EBADHISTORY
goto 999
end if
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, trim(unknown_mes))
end if
if (present(source)) then
call Get_Attr(history % dimvars(1), '+source', source, trim(unknown_mes))
end if
if (present(institution)) then
call Get_Attr(history % dimvars(1), '+institution', institution, trim(unknown_mes))
end if
if (present(origin)) then
origin = history % origin
end if
if (present(interval)) then
interval = history % interval
end if
if (present(newest)) then
newest = history % newest
end if
if (present(oldest)) then
oldest = history % oldest
end if
if (present(conventions)) then
call Get_Attr(history % dimvars(1), '+Conventions', conventions, trim(unknown_mes))
end if
if (present(gt_version)) then
call Get_Attr(history % dimvars(1), '+gt_version', gt_version, trim(unknown_mes))
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
if (present(axes)) then
numvars = size(history % dimvars)
allocate(axes(numvars))
do i = 1, numvars
call Inquire(history % dimvars(i), allcount=axes(i) % length, xtype=axes(i) % xtype, name=axes(i) % name)
call Get_Attr(history % dimvars(i), 'long_name', axes(i) % longname, 'unknown')
call Get_Attr(history % dimvars(i), 'units', axes(i) % units, 'unknown')
! 属性 GT_HISTORY_ATTR はまだ取得できない
!
! するためには, 属性名に対して様々な型が存在しうると
! 考えられるため, get_attr (gtdata_generic および an_generic)
! に err 属性を装備させ, 取得できない際にエラーを
! 返してもらわなければならないだろう.
end do
end if
if (present(varinfo)) then
if (.not. associated(history % vars) .or. size(history % vars) < 1) then
stat = NF_ENOTVAR
goto 999
end if
numvars = size(history % vars)
allocate(varinfo(numvars))
do i = 1, numvars
call Inquire(history % vars(i), alldims=alldims, xtype=varinfo(i) % xtype, name=varinfo(i) % name)
call Get_Attr(history % vars(i), 'long_name', varinfo(i) % longname, 'unknown')
call Get_Attr(history % vars(i), 'units', varinfo(i) % units, 'unknown')
! 属性 GT_HISTORY_ATTR はまだ取得できない
!
! するためには, 属性名に対して様々な型が存在しうると
! 考えられるため, get_attr (gtdata_generic および an_generic)
! に err 属性を装備させ, 取得できない際にエラーを
! 返してもらわなければならないだろう.
allocate(varinfo(i) % dims(alldims))
do j = 1, alldims
call Open(var=dimvar, source_var=history % vars(i), dimord=j, count_compact=.true.)
call Inquire(dimvar, name=varinfo(i) % dims(j))
call Close(dimvar)
end do
end do
end if
999 continue
call StoreError(stat, subname, err, cause_c=cause_c)
call EndSub(subname)
end subroutine HistoryInquire1
Subroutine : |
|
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
|
GT_HISTORY_VARINFO
型の変数内の各情報を参照します。
dims はポインタ配列です。空状態にして与えてください。
[Source]
subroutine HistoryVarinfoInquire1( varinfo, name, dims, longname, units, xtype)
!
!== GT_HISTORY_VARINFO 型変数への問い合わせ
!
! GT_HISTORY_VARINFO 型の変数内の各情報を参照します。
!
! dims はポインタ配列です。空状態にして与えてください。
!
use dc_types, only: STRING, TOKEN, DP
use dc_trace, only: BeginSub, EndSub, DbgMessage
implicit none
type(GT_HISTORY_VARINFO),intent(in) :: varinfo
character(*), intent(out), optional:: name ! 次元変数名
character(*), pointer, optional:: dims(:) !(out) 依存する次元
character(*), intent(out), optional:: longname ! 次元変数の記述的名称
character(*), intent(out), optional:: units ! 次元変数の単位
character(*), intent(out), optional:: xtype ! 次元変数の型
! Internal Work
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | character(*), intent(in)
: | 属性に与えられる値
配列の場合でも、数値型以外 では配列の 1 つ目の要素のみ
値として付加されます。
|
|
GT_HISTORY_AXIS 型の変数 axis
へ属性を付加します。
HistoryAxisAddAttr
は複数のサブルーチンの総称名です。 value
には様々な型の引数を与えることが可能です。
下記のサブルーチンを参照ください。
[Source]
subroutine HistoryAxisAddAttrChar0( axis, attrname, value)
!
!
!== GT_HISTORY_AXIS 型変数への属性付加
!
! GT_HISTORY_AXIS 型の変数 *axis* へ属性を付加します。
!
! *HistoryAxisAddAttr* は複数のサブルーチンの総称名です。
! value には様々な型の引数を与えることが可能です。
! 下記のサブルーチンを参照ください。
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
character(*), intent(in):: value
! 属性に与えられる値
!
! 配列の場合でも、数値型以外
! では配列の 1 つ目の要素のみ
! 値として付加されます。
!
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | integer, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrInt0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | logical, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrLogical0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real(DP), intent(in)
|
[Source]
subroutine HistoryAxisAddAttrDouble0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrReal0( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | integer, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrInt1( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real(DP), intent(in)
|
[Source]
subroutine HistoryAxisAddAttrDouble1( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
axis : | type(GT_HISTORY_AXIS),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real, intent(in)
|
[Source]
subroutine HistoryAxisAddAttrReal1( axis, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_AXIS),intent(inout) :: axis
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | character(*), intent(in)
: | 属性に与えられる値
配列の場合でも、数値型以外 では配列の 1 つ目の要素のみ
値として付加されます。
|
|
GT_HISTORY_VARINFO 型の変数
varinfo へ属性を付加します。
HistoryVarinfoAddAttr
は複数のサブルーチンの総称名です。 value
には様々な型の引数を与えることが可能です。
下記のサブルーチンを参照ください。
[Source]
subroutine HistoryVarinfoAddAttrChar0( varinfo, attrname, value)
!
!
!== GT_HISTORY_VARINFO 型変数への属性付加
!
! GT_HISTORY_VARINFO 型の変数 *varinfo* へ属性を付加します。
!
! *HistoryVarinfoAddAttr* は複数のサブルーチンの総称名です。
! value には様々な型の引数を与えることが可能です。
! 下記のサブルーチンを参照ください。
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
character(*), intent(in):: value
! 属性に与えられる値
!
! 配列の場合でも、数値型以外
! では配列の 1 つ目の要素のみ
! 値として付加されます。
!
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | integer, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrInt0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | logical, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrLogical0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real(DP), intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrDouble0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value : | real, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrReal0( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | integer, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrInt1( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
integer, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real(DP), intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrDouble1( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
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:: 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
Subroutine : |
|
varinfo : | type(GT_HISTORY_VARINFO),intent(inout)
|
attrname : | character(*), intent(in)
|
value(:) : | real, intent(in)
|
[Source]
subroutine HistoryVarinfoAddAttrReal1( varinfo, attrname, value)
!
!
use gtdata_generic, only: Put_Attr
use dc_string , only: toChar, JoinChar
use dc_url , only: GT_PLUS
implicit none
type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
character(*), intent(in):: attrname ! 属性の名前
real, intent(in):: value(:)
type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
integer:: 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
gtool4_netCDF_Conventions
Function : |
|
result : | integer
|
history : | type(GT_HISTORY),
intent(in)
|
varname : | character(len = *), intent(in)
|
history 内の varname 変数の変数番号を返す. 現在, 明示的に history
変数を与えない場合の変数番号の 検索は出来ない.
[Source]
integer function lookup_variable_ord(history, varname) result(result)
!
! history 内の varname 変数の変数番号を返す.
! 現在, 明示的に history 変数を与えない場合の変数番号の
! 検索は出来ない.
!
use dc_types, only: string
use gtdata_generic, only: inquire
type(GT_HISTORY), intent(in):: history
character(len = *), intent(in):: varname
character(len = string):: name
character(len = *), parameter:: subname = 'lookup_variable_ord'
continue
call BeginSub(subname)
if (associated(history%vars)) then
do, result = 1, size(history%vars)
call Inquire(history%vars(result), name=name)
if (name == varname) goto 999
call DbgMessage('no match <%c> <%c>', c1=trim(name), c2=trim(varname))
enddo
endif
result = 0
999 continue
call EndSub(subname, "result=%d", i=(/result/))
end function