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

Go to the source code of this file.

Functions/Subroutines

subroutine hstnmlinfoputline (gthstnml, unit, indent, err)

Function/Subroutine Documentation

◆ hstnmlinfoputline()

subroutine hstnmlinfoputline ( type(gthst_nmlinfo), intent(in) gthstnml,
integer, intent(in), optional unit,
character(*), intent(in), optional indent,
logical, intent(out), optional err )

Definition at line 10 of file hstnmlinfoputline.f90.

11 !
12 ! 引数 *gthstnml* に設定されている情報を印字します.
13 ! デフォルトではメッセージは標準出力に出力されます.
14 ! *unit* に装置番号を指定することで, 出力先を変更することが可能です.
15 !
16 ! Print information of *gthstnml*.
17 ! By default messages are output to standard output.
18 ! Unit number for output can be changed by *unit* argument.
19 !
20 use gtool_history_nmlinfo_types, only: gthst_nmlinfo, gthst_nmlinfo_entry
21 use gtool_history_nmlinfo_internal, only: listnext
22 use gtool_history_generic, only: historyputline
23 use dc_trace, only: beginsub, endsub
24 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
25 use dc_types, only: dp, string, token, stdout
26 use dc_error, only: storeerror, dc_noerr, dc_enotinit
27 implicit none
28 type(GTHST_NMLINFO), intent(in):: gthstnml
29 integer, intent(in), optional:: unit
30 ! 出力先の装置番号.
31 ! デフォルトの出力先は標準出力.
32 !
33 ! Unit number for output.
34 ! Default value is standard output.
35 character(*), intent(in), optional:: indent
36 ! 表示されるメッセージの字下げ.
37 !
38 ! Indent of displayed messages.
39 logical, intent(out), optional:: err
40 ! 例外処理用フラグ.
41 ! デフォルトでは, この手続き内でエラーが
42 ! 生じた場合, プログラムは強制終了します.
43 ! 引数 *err* が与えられる場合,
44 ! プログラムは強制終了せず, 代わりに
45 ! *err* に .true. が代入されます.
46 !
47 ! Exception handling flag.
48 ! By default, when error occur in
49 ! this procedure, the program aborts.
50 ! If this *err* argument is given,
51 ! .true. is substituted to *err* and
52 ! the program does not abort.
53
54 !-----------------------------------
55 ! 作業変数
56 ! Work variables
57 type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
58 integer:: stat
59 character(STRING):: cause_c
60 integer:: out_unit
61 integer:: indent_len
62 character(STRING):: indent_str
63 character(*), parameter:: subname = 'HstNmlInfoPutLine'
64 continue
65 call beginsub( subname )
66 stat = dc_noerr
67 cause_c = ''
68
69 !-----------------------------------------------------------------
70 ! 初期設定のチェック
71 ! Check initialization
72 !-----------------------------------------------------------------
73 if ( present(unit) ) then
74 out_unit = unit
75 else
76 out_unit = stdout
77 end if
78
79 indent_len = 0
80 indent_str = ''
81 if ( present(indent) ) then
82 if ( len(indent) /= 0 ) then
83 indent_len = len(indent)
84 indent_str(1:indent_len) = indent
85 end if
86 end if
87
88 !-----------------------------------------------------------------
89 ! "GTHST_NMLINFO" の設定の印字
90 ! Print the settings for "GTHST_NMLINFO"
91 !-----------------------------------------------------------------
92 if ( gthstnml % initialized ) then
93 call printf( out_unit, &
94 & indent_str(1:indent_len) // &
95 & '#<GTHST_NMLINFO:: @initialized=%y define_mode=%y', &
96 & l = (/gthstnml % initialized, gthstnml % define_mode/) )
97
98 hptr => gthstnml % gthstnml_list
99
100 do while ( associated( hptr ) )
101
102 call printf( out_unit, &
103 & indent_str(1:indent_len) // &
104 & ' #<GTHST_NMLINFO_ENTRY:: @name=%c @file=%c', &
105 & c1 = trim(hptr % name), &
106 & c2 = trim(hptr % file) )
107
108 call printf( out_unit, &
109 & indent_str(1:indent_len) // &
110 & ' @interval_value=%r @interval_unit=%c', &
111 & r = (/hptr % interval_value/), &
112 & c1 = trim(hptr % interval_unit) )
113
114 call printf( out_unit, &
115 & indent_str(1:indent_len) // &
116 & ' @output_step_disable=%y', &
117 & l = (/hptr % output_step_disable/) )
118
119 call printf( out_unit, &
120 & indent_str(1:indent_len) // &
121 & ' @precision=%c @time_average=%y', &
122 & c1 = trim(hptr % precision), &
123 & l = (/ hptr % time_average /) )
124
125 call printf( out_unit, &
126 & indent_str(1:indent_len) // &
127 & ' @fileprefix=%c', &
128 & c1 = trim(hptr % fileprefix) )
129
130 call printf( out_unit, &
131 & indent_str(1:indent_len) // &
132 & ' @origin_value=%r @origin_unit=%c', &
133 & r = (/hptr % origin_value/), &
134 & c1 = trim(hptr % origin_unit) )
135
136 call printf( out_unit, &
137 & indent_str(1:indent_len) // &
138 & ' @terminus_value=%r @terminus_unit=%c', &
139 & r = (/hptr % terminus_value/), &
140 & c1 = trim(hptr % terminus_unit) )
141
142 call printf( out_unit, &
143 & indent_str(1:indent_len) // &
144 & ' @slice_start=%*d ...', &
145 & i = (/hptr % slice_start(1:10)/), n = (/ 10 /) )
146
147 call printf( out_unit, &
148 & indent_str(1:indent_len) // &
149 & ' @slice_end=%*d ...', &
150 & i = (/hptr % slice_end(1:10)/), n = (/ 10 /) )
151
152 call printf( out_unit, &
153 & indent_str(1:indent_len) // &
154 & ' @slice_stride=%*d ...', &
155 & i = (/hptr % slice_stride(1:10)/), n = (/ 10 /) )
156
157 call printf( out_unit, &
158 & indent_str(1:indent_len) // &
159 & ' @space_average=%*b ...', &
160 & l = (/hptr % space_average(1:10)/), n =(/ 10 /) )
161
162 call printf( out_unit, &
163 & indent_str(1:indent_len) // &
164 & ' @newfile_intvalue=%d @newfile_intunit=%c', &
165 & i = (/hptr % newfile_intvalue/), &
166 & c1 = trim(hptr % newfile_intunit) )
167
168 if ( .not. gthstnml % define_mode ) then
169 call printf( out_unit, &
170 & indent_str(1:indent_len) // &
171 & ' @history=' )
172
173 call historyputline( hptr % history, &
174 & unit = out_unit, &
175 & indent = indent_str(1:indent_len) // &
176 & ' ' )
177 end if
178
179 call listnext( gthstnml_list = hptr ) ! (inout)
180 end do
181
182 call printf( out_unit, &
183 & indent_str(1:indent_len) // &
184 & ' >' )
185
186 call printf( out_unit, &
187 & indent_str(1:indent_len) // &
188 & '>' )
189 else
190 call printf( out_unit, &
191 & indent_str(1:indent_len) // &
192 & '#<GTHST_NMLINFO:: @initialized=%y>', &
193 & l = (/gthstnml % initialized/) )
194 end if
195
196 !-----------------------------------------------------------------
197 ! 終了処理, 例外処理
198 ! Termination and Exception handling
199 !-----------------------------------------------------------------
200999 continue
201 call storeerror( stat, subname, err, cause_c )
202 call endsub( subname )
historyputline
subroutine historyputline(history, unit, indent, err)
Definition historyputline.f90:11
gtool_history_nmlinfo_internal::listnext
Definition gtool_history_nmlinfo_internal.f90:43
dc_error
Definition dc_error.f90:11
dc_error::storeerror
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:830
dc_error::dc_enotinit
integer, parameter, public dc_enotinit
Definition dc_error.f90:557
dc_error::dc_noerr
integer, parameter, public dc_noerr
Definition dc_error.f90:509
dc_types
種別型パラメタを提供します。
Definition dc_types.f90:49
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition dc_types.f90:109
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition dc_types.f90:118
dc_types::stdout
integer, parameter, public stdout
標準出力の装置番号
Definition dc_types.f90:98
dc_types::dp
integer, parameter, public dp
倍精度実数型変数
Definition dc_types.f90:83
gtool_history_nmlinfo_internal
Definition gtool_history_nmlinfo_internal.f90:11
gtool_history_nmlinfo_types
Definition gtool_history_nmlinfo_types.f90:11
gtool_history_nmlinfo_types::gthst_nmlinfo_entry
Definition gtool_history_nmlinfo_types.f90:75
gtool_history_nmlinfo_types::gthst_nmlinfo
Definition gtool_history_nmlinfo_types.f90:42

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

Here is the call graph for this function: