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 11 of file historyputline.f90.

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

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  !-----------------------------------------------------------------
322 999 continue
323  call storeerror( stat, subname, err, cause_c )
324  call endsub( subname )
dc_error
Definition: dc_error.f90:11
dc_error::dc_enotinit
integer, parameter, public dc_enotinit
Definition: dc_error.f90:557
dc_types::token
integer, parameter, public token
Character length for word, token.
Definition: dc_types.f90:109
dc_date_generic::evalbyunit
Definition: dc_date_generic.f90:523
dc_error::storeerror
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition: dc_error.f90:830
dc_error::dc_noerr
integer, parameter, public dc_noerr
Definition: dc_error.f90:509
dc_types::dp
integer, parameter, public dp
Double Precision Real number.
Definition: dc_types.f90:83
dc_date_generic::max
Definition: dc_date_generic.f90:870
dc_types::stdout
integer, parameter, public stdout
Unit number for Standard OUTPUT.
Definition: dc_types.f90:98
gtdata_netcdf_generic::get_attr
Definition: gtdata_netcdf_generic.f90:235
dc_types
Provides kind type parameter values.
Definition: dc_types.f90:49
dc_date
Definition: dc_date.f90:9
gtool_history_types
Definition: gtool_history_types.f90:12
dc_types::string
integer, parameter, public string
Character length for string.
Definition: dc_types.f90:118
Here is the call graph for this function: