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

Go to the source code of this file.

Functions/Subroutines

subroutine historyputline (history, unit, indent, err)
 

Function/Subroutine Documentation

◆ historyputline()

subroutine historyputline ( type(gt_history), intent(in), optional, target  history,
integer, intent(in), optional  unit,
character(*), intent(in), optional  indent,
logical, intent(out), optional  err 
)

Definition at line 10 of file historyputline.f90.

11 !
12 ! 引数 *history* に設定されている情報を印字します.
13 ! デフォルトではメッセージは標準出力に出力されます.
14 ! *unit* に装置番号を指定することで, 出力先を変更することが可能です.
15 !
16 ! Print information of *history*.
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_types, only: gt_history
21 use gtool_history_internal, only: default
22 use gtool_history_generic, only: historyinquire
23 use gtdata_generic, only: putline, get_attr
24 use dc_trace, only: beginsub, endsub
25 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
26 use dc_types, only: dp, string, token, stdout
27 use dc_error, only: storeerror, dc_noerr, dc_enotinit
28 use dc_date, only: evalbyunit
29 implicit none
30 type(GT_HISTORY), intent(in), target, optional:: history
31 integer, intent(in), optional:: unit
32 ! 出力先の装置番号.
33 ! デフォルトの出力先は標準出力.
34 !
35 ! Unit number for output.
36 ! Default value is standard output.
37 character(*), intent(in), optional:: indent
38 ! 表示されるメッセージの字下げ.
39 !
40 ! Indent of displayed messages.
41 logical, intent(out), optional:: err
42 ! 例外処理用フラグ.
43 ! デフォルトでは, この手続き内でエラーが
44 ! 生じた場合, プログラムは強制終了します.
45 ! 引数 *err* が与えられる場合,
46 ! プログラムは強制終了せず, 代わりに
47 ! *err* に .true. が代入されます.
48 !
49 ! Exception handling flag.
50 ! By default, when error occur in
51 ! this procedure, the program aborts.
52 ! If this *err* argument is given,
53 ! .true. is substituted to *err* and
54 ! the program does not abort.
55
56 !-----------------------------------
57 ! 作業変数
58 ! Work variables
59 type(GT_HISTORY), pointer:: hst =>null()
60 integer:: i, max
61 integer:: stat
62 character(STRING):: cause_c
63 integer:: out_unit
64 integer:: indent_len
65 character(STRING):: indent_str
66
67 character(STRING):: file, title, source, institution
68 character(STRING):: conventions, gt_version
69 character(TOKEN), pointer:: dims(:) =>null()
70 integer, pointer:: dimsizes(:) =>null()
71 character(STRING), pointer:: longnames(:) =>null()
72 character(TOKEN), pointer:: units(:) =>null()
73 character(TOKEN), pointer:: xtypes(:) =>null()
74
75 real:: origin, interval, newest, oldest
76 character(*), parameter:: subname = 'HistoryPutLine'
77 continue
78 call beginsub( subname )
79 stat = dc_noerr
80 cause_c = ''
81
82 !-----------------------------------------------------------------
83 ! 出力先装置番号と字下げの設定
84 ! Configure output unit number and indents
85 !-----------------------------------------------------------------
86 if ( present(unit) ) then
87 out_unit = unit
88 else
89 out_unit = stdout
90 end if
91
92 indent_len = 0
93 indent_str = ''
94 if ( present(indent) ) then
95 if ( len(indent) /= 0 ) then
96 indent_len = len(indent)
97 indent_str(1:indent_len) = indent
98 end if
99 end if
100
101 if (present(history)) then
102 hst => history
103 else
104 hst => default
105 endif
106
107 !-----------------------------------------------------------------
108 ! "GT_HISTORY" の設定の印字
109 ! Print the settings for "GT_HISTORY"
110 !-----------------------------------------------------------------
111 if ( hst % initialized ) then
112 call printf( out_unit, &
113 & indent_str(1:indent_len) // &
114 & '#<GT_HISTORY:: @initialized=%y', &
115 & l = (/hst % initialized/) )
116
117 call historyinquire( history = hst, & ! (in)
118 & err = err, & ! (out)
119 & file = file, title = title, & ! (out)
120 & source = source, institution = institution, & ! (out)
121 & dims = dims, dimsizes = dimsizes, & ! (out)
122 & longnames = longnames, & ! (out)
123 & units = units, xtypes = xtypes, & ! (out)
124 & conventions = conventions, & ! (out)
125 & gt_version = gt_version ) ! (out)
126
127 call printf( out_unit, &
128 & indent_str(1:indent_len) // &
129 & ' @file=%c @title=%c', &
130 & c1 = trim(file), c2 = trim(title) )
131
132 call printf( out_unit, &
133 & indent_str(1:indent_len) // &
134 & ' @source=%c @institution=%c', &
135 & c1 = trim(source), c2 = trim(institution) )
136
137 max = size( dims )
138 call printf( out_unit, &
139 & indent_str(1:indent_len) // &
140 & ' @dims=%c @dimsizes=%*d', &
141 & c1 = trim( joinchar(dims, ',') ), &
142 & i = dimsizes, n = (/max/) )
143 deallocate( dims, dimsizes )
144
145 call printf( out_unit, &
146 & indent_str(1:indent_len) // &
147 & ' @longnames=%c', &
148 & c1 = trim( joinchar(longnames, ',') ) )
149 deallocate( longnames )
150
151 call printf( out_unit, &
152 & indent_str(1:indent_len) // &
153 & ' @units=%c @xtypes=%c', &
154 & c1 = trim( joinchar(units, ',') ), &
155 & c2 = trim( joinchar(xtypes, ',') ) )
156 deallocate( units, xtypes )
157
158 call printf( out_unit, &
159 & indent_str(1:indent_len) // &
160 & ' @conventions=%c @gt_version=%c', &
161 & c1 = trim(conventions), c2 = trim(gt_version) )
162
163 call printf( out_unit, &
164 & indent_str(1:indent_len) // &
165 & ' @unlimited_index=%d', &
166 & i = (/hst % unlimited_index/) )
167
168 max = size( hst % dim_value_written )
169 call printf( out_unit, &
170 & indent_str(1:indent_len) // &
171 & ' @dim_value_written=%*y', &
172 & l = hst % dim_value_written, n = (/max/) )
173
174 origin = hst % origin
175 interval = hst % interval
176 newest = hst % newest
177 oldest = hst % oldest
178
179!!$ origin = EvalByUnit( hst % origin, '', hst % unlimited_units_symbol )
180!!$ interval = EvalByUnit( hst % interval, '', hst % unlimited_units_symbol )
181!!$ newest = EvalByUnit( hst % newest, '', hst % unlimited_units_symbol )
182!!$ oldest = EvalByUnit( hst % oldest, '', hst % unlimited_units_symbol )
183
184 call printf( out_unit, &
185 & indent_str(1:indent_len) // &
186 & ' @origin=%r @interval=%r @newest=%r @oldest=%r', &
187 & r = (/origin, interval, newest, oldest/) )
188
189 if ( associated( hst % growable_indices ) ) then
190 max = size( hst % growable_indices )
191 call printf( out_unit, &
192 & indent_str(1:indent_len) // &
193 & ' @growable_indices=%*d', &
194 & i = hst % growable_indices, n = (/max/) )
195 else
196 call printf( out_unit, &
197 & indent_str(1:indent_len) // &
198 & ' @growable_indices=<null>' )
199 end if
200
201 if ( associated( hst % count ) ) then
202 max = size( hst % count )
203 call printf( out_unit, &
204 & indent_str(1:indent_len) // &
205 & ' @count=%*d', &
206 & i = hst % count, n = (/max/) )
207 else
208 call printf( out_unit, &
209 & indent_str(1:indent_len) // &
210 & ' @count=<null>' )
211 end if
212
213 if ( associated( hst % dimvars ) ) then
214 call printf( out_unit, &
215 & indent_str(1:indent_len) // &
216 & ' @dimvars=' )
217 max = size( hst % dimvars )
218 do i = 1, max
219 call putline( hst % dimvars(i), out_unit, &
220 & indent_str(1:indent_len) // ' ', err )
221 end do
222 else
223 call printf( out_unit, &
224 & indent_str(1:indent_len) // &
225 & ' @dimvars=<null>' )
226 end if
227
228 if ( associated( hst % vars ) ) then
229 call printf( out_unit, &
230 & indent_str(1:indent_len) // &
231 & ' @vars=' )
232 max = size( hst % vars )
233 do i = 1, max
234 call putline( hst % vars(i), out_unit, &
235 & indent_str(1:indent_len) // ' ', err )
236 end do
237 else
238 call printf( out_unit, &
239 & indent_str(1:indent_len) // &
240 & ' @vars=<null>' )
241 end if
242
243 if ( associated( hst % var_avr_count ) ) then
244 max = size( hst % var_avr_count )
245 call printf( out_unit, &
246 & indent_str(1:indent_len) // &
247 & ' @var_avr_count=%*d', &
248 & i = hst % var_avr_count, n = (/max/) )
249 else
250 call printf( out_unit, &
251 & indent_str(1:indent_len) // &
252 & ' @var_avr_count=<null>' )
253 end if
254
255 if ( associated( hst % var_avr_firstput ) ) then
256 max = size( hst % var_avr_firstput )
257 call printf( out_unit, &
258 & indent_str(1:indent_len) // &
259 & ' @var_avr_firstput=%*b', &
260 & l = hst % var_avr_firstput, n = (/max/) )
261 else
262 call printf( out_unit, &
263 & indent_str(1:indent_len) // &
264 & ' @var_avr_firstput=<null>' )
265 end if
266
267 if ( associated( hst % var_avr_coefsum ) ) then
268 max = size( hst % var_avr_coefsum )
269 call printf( out_unit, &
270 & indent_str(1:indent_len) // &
271 & ' @var_avr_coefsum=%*f', &
272 & d = hst % var_avr_coefsum, n = (/max/) )
273 else
274 call printf( out_unit, &
275 & indent_str(1:indent_len) // &
276 & ' @var_avr_coefsum=<null>' )
277 end if
278
279 call printf( out_unit, &
280 & indent_str(1:indent_len) // &
281 & ' @time_bnds=%*f, @time_bnds_output_count=%d', &
282 & i = (/hst % time_bnds_output_count/), &
283 & d = hst % time_bnds, &
284 & n = (/ size(hst % time_bnds) /) )
285
286 if ( associated( hst % var_avr_data ) ) then
287 call printf( out_unit, &
288 & indent_str(1:indent_len) // &
289 & ' @var_avr_data=' )
290 max = size( hst % var_avr_data )
291 do i = 1, max
292 call printf( out_unit, &
293 & indent_str(1:indent_len) // &
294 & ' #<GT_HISTORY_AVRDATA:: @length=%d', &
295 & i = (/hst % var_avr_data(i) % length/) )
296 call putline( hst % var_avr_data(i) % a_DataAvr, unit = out_unit, &
297 & lbounds = lbound(hst % var_avr_data(i) % a_DataAvr), &
298 & ubounds = ubound(hst % var_avr_data(i) % a_DataAvr), &
299 & indent = indent_str(1:indent_len) // &
300 & ' @a_DataAvr=' )
301 end do
302 else
303 call printf( out_unit, &
304 & indent_str(1:indent_len) // &
305 & ' @var_avr_data=<null>' )
306 end if
307
308 call printf( out_unit, &
309 & indent_str(1:indent_len) // &
310 & '>' )
311 else
312 call printf( out_unit, &
313 & indent_str(1:indent_len) // &
314 & '#<GT_HISTORY:: @initialized=%y>', &
315 & l = (/hst % initialized/) )
316 end if
317
318 !-----------------------------------------------------------------
319 ! 終了処理, 例外処理
320 ! Termination and Exception handling
321 !-----------------------------------------------------------------
322999 continue
323 call storeerror( stat, subname, err, cause_c )
324 call endsub( subname )
dc_date
Definition dc_date.f90:9
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
Provides kind type parameter values.
Definition dc_types.f90:49
dc_types::stdout
integer, parameter, public stdout
Unit number for Standard OUTPUT
Definition dc_types.f90:98
dc_types::token
integer, parameter, public token
Character length for word, token
Definition dc_types.f90:109
dc_types::dp
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:83
dc_types::string
integer, parameter, public string
Character length for string
Definition dc_types.f90:118
gtool_history_types
Definition gtool_history_types.f90:12
gtool_history_types::default
type(gt_history), target, save default
Definition gtool_history_types.f90:188
gtool_history_types::gt_history
Definition gtool_history_types.f90:42

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

Here is the call graph for this function: