Loading...
Searching...
No Matches
Functions/Subroutines
hstnmlinfoassocgthist.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine hstnmlinfoassocgthist (gthstnml, name, history, err)
 

Function/Subroutine Documentation

◆ hstnmlinfoassocgthist()

subroutine hstnmlinfoassocgthist ( type(gthst_nmlinfo), intent(in)  gthstnml,
character(*), intent(in)  name,
type(gt_history), pointer  history,
logical, intent(out), optional  err 
)

Definition at line 10 of file hstnmlinfoassocgthist.f90.

12 !
13 ! 与えられた gtool_history_types#GT_HISTORY 型のポインタ *history* に対し,
14 ! *gthstnml* 内の *name* に関する gtool_history_types#GT_HISTORY 型変数を
15 ! 結合します.
16 ! 空状態の *history* を与えてください.
17 !
18 ! HstNmlInfoEndDefine で定義モードから出力モードに
19 ! 移行した後に呼び出してください.
20 ! HstNmlInfoEndDefine を呼ぶ前にこのサブルーチンを使用すると,
21 ! プログラムはエラーを発生させます.
22 !
23 ! *name* に関する情報が見当たらない場合,
24 ! プログラムはエラーを発生させます.
25 ! *name* が空文字の場合にも,
26 ! プログラムはエラーを発生させます.
27 !
28 ! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
29 ! されていない場合にも, プログラムはエラーを発生させます.
30 !
31 ! This subroutine associates given "gtool_history_types#GT_HISTORY"
32 ! pointer *history* to
33 ! "gtool_history_types#GT_HISTORY" correspond to *name* in *gthstnml*.
34 ! Give null *history*.
35 !
36 ! Use after state is changed from define mode to
37 ! output mode by "HstNmlInfoEndDefine".
38 ! If this subroutine is used before
39 ! "HstNmlInfoEndDefine" is used, error is occurred.
40 !
41 ! When data correspond to *name* is not found,
42 ! error is occurred.
43 ! When *name* is blank,
44 ! error is occurred too.
45 !
46 ! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
47 ! error is occurred.
48 !
51 use gtool_history, only: gt_history
52 use dc_trace, only: beginsub, endsub
53 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
54 use dc_types, only: dp, string, token, stdout
56 implicit none
57 type(GTHST_NMLINFO), intent(in):: gthstnml
58 character(*), intent(in):: name
59 ! 変数名.
60 ! 先頭の空白は無視されます.
61 !
62 ! Variable identifier.
63 ! Blanks at the head of the name are ignored.
64 type(GT_HISTORY), pointer:: history
65 ! (out)
66 !
67 ! gtool_history モジュール用構造体.
68 ! Derived type for "gtool_history" module
69 logical, intent(out), optional:: err
70 ! 例外処理用フラグ.
71 ! デフォルトでは, この手続き内でエラーが
72 ! 生じた場合, プログラムは強制終了します.
73 ! 引数 *err* が与えられる場合,
74 ! プログラムは強制終了せず, 代わりに
75 ! *err* に .true. が代入されます.
76 !
77 ! Exception handling flag.
78 ! By default, when error occur in
79 ! this procedure, the program aborts.
80 ! If this *err* argument is given,
81 ! .true. is substituted to *err* and
82 ! the program does not abort.
83
84 !-----------------------------------
85 ! 作業変数
86 ! Work variables
87 type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
88 integer:: stat
89 character(STRING):: cause_c
90 character(*), parameter:: subname = 'HstNmlInfoAssocGtHist'
91 continue
92 call beginsub( subname )
93 stat = dc_noerr
94 cause_c = ''
95
96 !-----------------------------------------------------------------
97 ! 初期設定のチェック
98 ! Check initialization
99 !-----------------------------------------------------------------
100 if ( .not. gthstnml % initialized ) then
101 stat = dc_enotinit
102 cause_c = 'GTHST_NMLINFO'
103 goto 999
104 end if
105
106 if ( trim( name ) == '' ) then
107 stat = hst_ebadname
108 cause_c = ''
109 goto 999
110 end if
111
112 if ( gthstnml % define_mode ) then
113 stat = hst_eindefine
114 cause_c = 'AssocGtHist'
115 goto 999
116 end if
117
118 !-----------------------------------------------------------------
119 ! *gthstnml* 内から, *name* に関する history を探査.
120 ! Search "history" correspond to *name* in *gthstnml*
121 !-----------------------------------------------------------------
122 hptr => gthstnml % gthstnml_list
123 call listsearch( gthstnml_list = hptr, & ! (inout)
124 & name = name ) ! (in)
125
126 if ( .not. associated( hptr ) ) then
127 stat = dc_enoentry
128 cause_c = adjustl( name )
129 goto 999
130 end if
131
132 nullify( history )
133 history => hptr % history
134
135 nullify( hptr )
136
137 !-----------------------------------------------------------------
138 ! 終了処理, 例外処理
139 ! Termination and Exception handling
140 !-----------------------------------------------------------------
141999 continue
142 call storeerror( stat, subname, err, cause_c )
143 call endsub( subname )
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:830
integer, parameter, public dc_enotinit
Definition dc_error.f90:557
integer, parameter, public dc_noerr
Definition dc_error.f90:509
integer, parameter, public hst_eindefine
Definition dc_error.f90:582
integer, parameter, public hst_ebadname
Definition dc_error.f90:584
integer, parameter, public dc_enoentry
Definition dc_error.f90:571
Provides kind type parameter values.
Definition dc_types.f90:49
integer, parameter, public stdout
Unit number for Standard OUTPUT
Definition dc_types.f90:98
integer, parameter, public token
Character length for word, token
Definition dc_types.f90:109
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:83
integer, parameter, public string
Character length for string
Definition dc_types.f90:118

References dc_error::dc_enoentry, dc_error::dc_enotinit, dc_error::dc_noerr, dc_types::dp, dc_error::hst_ebadname, dc_error::hst_eindefine, dc_types::stdout, dc_error::storeerror(), dc_types::string, and dc_types::token.

Here is the call graph for this function: