gtool5 Fortran 90/95 Library 1.0.0-rc5
日本語
Loading...
Searching...
No Matches
hstnmlinfocreate.f90
Go to the documentation of this file.
1!> @file hstnmlinfocreate.f90
2!>
3!> @author Yasuhiro MORIKAWA
4!> @copyright Copyright (C) GFD Dennou Club, 2007-2026. All rights reserved. <br/>
5!> License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
6!>
7!> @en
8!> @brief Constructor of gtool_history_nmlinfo_types::GTHST_NMLINFO
9!> @enden
10!>
11!> @ja
12!> @brief gtool_history_nmlinfo_types::GTHST_NMLINFO 型の変数の初期設定
13!> @endja
14
15 !> @en
16 !> @brief Constructor of gtool_history_nmlinfo_types::GTHST_NMLINFO
17 !>
18 !> Initialize @p gthstnml by this subroutine,
19 !> before other procedures are used.
20 !>
21 !> @p interval_value,
22 !> @p interval_unit,
23 !> @p precision,
24 !> @p time_average (now-defunct @p average), etc.
25 !> are set as default values.
26 !> @p fileprefix is used as prefixes of output filenames of
27 !> each variable.
28 !>
29 !> Note that if @p gthstnml is already initialized
30 !> by this procedure, error is occurred.
31 !> @enden
32 !>
33 !> @ja
34 !> @brief gtool_history_nmlinfo_types::GTHST_NMLINFO 型の変数の初期設定
35 !>
36 !> GTHST_NMLINFO 型の変数の初期設定を行います.
37 !> 他のサブルーチンを使用する前に必ずこのサブルーチンによって
38 !> GTHST_NMLINFO 型の変数を初期設定してください.
39 !>
40 !> @p interval_value,
41 !> @p interval_unit,
42 !> @p precision,
43 !> @p time_average (旧 @p average) などの変数
44 !> はデフォルト値として設定されます.
45 !> @p fileprefix は各変数の出力ファイル名の接頭詞として
46 !> 使用されます.
47 !>
48 !> なお, 与えられた @p gthstnml が既に初期設定されている場合,
49 !> プログラムはエラーを発生させます.
50 !> @endja
51 !>
52 !> @param[inout] gthstnml gtool_history_nmlinfo_types::GTHST_NMLINFO 型変数
53 !> @param[in] interval_value 出力間隔の数値 (optional). Numerical value for interval.
54 !> @param[in] interval_unit 出力間隔の単位 (optional). Unit for interval.
55 !> @param[in] precision 精度 (optional). Precision.
56 !> @param[in] time_average 時間平均化フラグ (optional). Flag for time average.
57 !> @param[in] average time_average の旧版 (optional). Old version of time_average.
58 !> @param[in] fileprefix ファイル名の接頭詞 (optional). Prefixes of filenames.
59 !> @param[in] origin_value 出力開始時刻 (optional). Start time of output.
60 !> @param[in] origin_unit 出力開始時刻の単位 (optional). Unit of start time.
61 !> @param[in] terminus_value 出力終了時刻 (optional). End time of output.
62 !> @param[in] terminus_unit 出力終了時刻の単位 (optional). Unit of end time.
63 !> @param[in] slice_start 空間方向の開始点 (optional). Start points of spaces.
64 !> @param[in] slice_end 空間方向の終了点 (optional). End points of spaces.
65 !> @param[in] slice_stride 空間方向の刻み幅 (optional). Strides of spaces.
66 !> @param[in] space_average 平均化のフラグ (optional). Flag of average.
67 !> @param[in] newfile_intvalue ファイル分割時間間隔 (optional). Interval of file separation.
68 !> @param[in] newfile_intunit ファイル分割時間間隔の単位 (optional). Unit of file separation interval.
69 !> @param[out] err 例外処理用フラグ. Exception handling flag.
70 subroutine hstnmlinfocreate( gthstnml, &
71 & interval_value, &
72 & interval_unit, &
73 & precision, &
74 & time_average, average, &
75 & fileprefix, &
76 & origin_value, origin_unit, &
77 & terminus_value, terminus_unit, &
78 & slice_start, slice_end, slice_stride, &
79 & space_average, &
80 & newfile_intvalue, newfile_intunit, &
81 & err )
84 use dc_trace, only: beginsub, endsub
85 use dc_types, only: dp, string
88 use dc_date_types, only: dc_difftime
89 use dc_date, only: dcdifftimecreate
90 use netcdf, only: nf90_max_dims
91 implicit none
92 type(gthst_nmlinfo), intent(inout):: gthstnml
93 real(DP), intent(in), optional:: interval_value
94 ! ヒストリデータの出力間隔の数値.
95 ! 負の値を与えると, 出力を抑止します.
96 !
97 ! Numerical value for interval of history data output.
98 ! Negative values suppresses output.
99 character(*), intent(in), optional:: interval_unit
100 ! ヒストリデータの出力間隔の単位.
101 ! Unit for interval of history data output
102 character(*), intent(in), optional:: precision
103 ! ヒストリデータの精度.
104 ! Precision of history data
105 logical, intent(in), optional:: time_average
106 ! 出力データの時間平均化フラグ.
107 ! Flag for time average of output data.
108 logical, intent(in), optional:: average
109 ! time_average の旧版.
110 ! Old version of "time_average"
111 character(*), intent(in), optional:: fileprefix
112 ! ヒストリデータのファイル名の接頭詞.
113 ! Prefixes of history data filenames
114 real(DP), intent(in), optional:: origin_value
115 ! 出力開始時刻.
116 ! Start time of output.
117 character(*), intent(in), optional:: origin_unit
118 ! 出力開始時刻の単位.
119 ! Unit of start time of output.
120 real(DP), intent(in), optional:: terminus_value
121 ! 出力終了時刻.
122 ! End time of output.
123 character(*), intent(in), optional:: terminus_unit
124 ! 出力終了時刻の単位.
125 ! Unit of end time of output.
126 integer, intent(in), optional:: slice_start(:)
127 ! 空間方向の開始点.
128 ! Start points of spaces.
129 integer, intent(in), optional:: slice_end(:)
130 ! 空間方向の終了点.
131 ! End points of spaces.
132 integer, intent(in), optional:: slice_stride(:)
133 ! 空間方向の刻み幅.
134 ! Strides of spaces.
135 logical, intent(in), optional:: space_average(:)
136 ! 平均化のフラグ.
137 ! Flag of average.
138 integer, intent(in), optional:: newfile_intvalue
139 ! ファイル分割時間間隔.
140 ! Interval of time of separation of a file.
141 character(*), intent(in), optional:: newfile_intunit
142 ! ファイル分割時間間隔の単位.
143 ! Unit of interval of time of separation of a file.
144 logical, intent(out), optional:: err
145 ! 例外処理用フラグ.
146 ! デフォルトでは, この手続き内でエラーが
147 ! 生じた場合, プログラムは強制終了します.
148 ! 引数 *err* が与えられる場合,
149 ! プログラムは強制終了せず, 代わりに
150 ! *err* に .true. が代入されます.
151 !
152 ! Exception handling flag.
153 ! By default, when error occur in
154 ! this procedure, the program aborts.
155 ! If this *err* argument is given,
156 ! .true. is substituted to *err* and
157 ! the program does not abort.
158
159 !-----------------------------------
160 ! 作業変数
161 ! Work variables
162 type(dc_difftime):: interval_time
163 integer:: stat, ary_size
164 character(STRING):: cause_c
165 character(*), parameter:: subname = 'HstNmlInfoCreate'
166 continue
167 call beginsub( subname, &
168 & fmt = '@interval_value=%r @interval_unit=%c @precision=%c @time_average=%y @fileprefix=%c', &
169 & d = (/ present_select(.true., -1.0_dp, interval_value) /), &
170 & c1 = trim( present_select(.true., '<no>', interval_unit) ), &
171 & c2 = trim( present_select(.true., '<no>', precision) ), &
172 & l = (/ present_and_true(time_average) /), &
173 & c3 = trim( present_select(.true., '<no>', fileprefix) ), &
174 & version = version )
175 stat = dc_noerr
176 cause_c = ''
177
178 !-----------------------------------------------------------------
179 ! 初期設定のチェック
180 ! Check initialization
181 !-----------------------------------------------------------------
182 if ( gthstnml % initialized ) then
183 stat = dc_ealreadyinit
184 cause_c = 'GTHST_NMLINFO'
185 goto 999
186 end if
187
188 !-----------------------------------------------------------------
189 ! 割付
190 ! Allocate
191 !-----------------------------------------------------------------
192 allocate( gthstnml % gthstnml_list )
193 nullify( gthstnml % gthstnml_list % next )
194
195 !-----------------------------------------------------------------
196 ! デフォルト値の設定
197 ! Configure default values
198 !-----------------------------------------------------------------
199 gthstnml % gthstnml_list % name = ''
200 gthstnml % gthstnml_list % file = ''
201
202 allocate( gthstnml % gthstnml_list % interval_value )
203 allocate( gthstnml % gthstnml_list % interval_unit )
204 allocate( gthstnml % gthstnml_list % precision )
205 allocate( gthstnml % gthstnml_list % time_average )
206 allocate( gthstnml % gthstnml_list % fileprefix )
207
208 allocate( gthstnml % gthstnml_list % origin_value )
209 allocate( gthstnml % gthstnml_list % origin_unit )
210 allocate( gthstnml % gthstnml_list % terminus_value )
211 allocate( gthstnml % gthstnml_list % terminus_unit )
212 allocate( gthstnml % gthstnml_list % slice_start (1:nf90_max_dims) )
213 allocate( gthstnml % gthstnml_list % slice_end (1:nf90_max_dims) )
214 allocate( gthstnml % gthstnml_list % slice_stride (1:nf90_max_dims) )
215 allocate( gthstnml % gthstnml_list % space_average (1:nf90_max_dims) )
216 allocate( gthstnml % gthstnml_list % newfile_intvalue )
217 allocate( gthstnml % gthstnml_list % newfile_intunit )
218
219
220 gthstnml % gthstnml_list % interval_value = -1.0
221 gthstnml % gthstnml_list % interval_unit = 'sec'
222 gthstnml % gthstnml_list % precision = 'float'
223 gthstnml % gthstnml_list % time_average = .false.
224 gthstnml % gthstnml_list % fileprefix = ''
225
226 gthstnml % gthstnml_list % origin_value = -1.0
227 gthstnml % gthstnml_list % origin_unit = 'sec'
228 gthstnml % gthstnml_list % terminus_value = -1.0
229 gthstnml % gthstnml_list % terminus_unit = 'sec'
230 gthstnml % gthstnml_list % slice_start = 1
231 gthstnml % gthstnml_list % slice_end = -1
232 gthstnml % gthstnml_list % slice_stride = 1
233 gthstnml % gthstnml_list % space_average = .false.
234 gthstnml % gthstnml_list % newfile_intvalue = -1
235 gthstnml % gthstnml_list % newfile_intunit = 'sec'
236
237 if ( present(interval_value) ) gthstnml % gthstnml_list % interval_value = &
238 & real( interval_value, kind = kind( gthstnml % gthstnml_list % interval_value ) )
239 if ( present(interval_unit) ) gthstnml % gthstnml_list % interval_unit = interval_unit
240 if ( present(precision) ) gthstnml % gthstnml_list % precision = precision
241
242 if ( present(average) ) gthstnml % gthstnml_list % time_average = average
243 if ( present(time_average) ) gthstnml % gthstnml_list % time_average = time_average
244 if ( present(fileprefix) ) gthstnml % gthstnml_list % fileprefix = fileprefix
245
246 if ( present(origin_value ) ) gthstnml % gthstnml_list % origin_value = &
247 & real( origin_value, kind = kind( gthstnml % gthstnml_list % origin_value ) )
248 if ( present(origin_unit ) ) gthstnml % gthstnml_list % origin_unit = origin_unit
249 if ( present(terminus_value ) ) gthstnml % gthstnml_list % terminus_value = &
250 & real( terminus_value, kind = kind( gthstnml % gthstnml_list % terminus_value ) )
251 if ( present(terminus_unit ) ) gthstnml % gthstnml_list % terminus_unit = terminus_unit
252 if ( present(slice_start ) ) then
253 ary_size = size(slice_start)
254 gthstnml % gthstnml_list % slice_start(1:ary_size) = slice_start
255 end if
256 if ( present(slice_end ) ) then
257 ary_size = size(slice_end)
258 gthstnml % gthstnml_list % slice_end(1:ary_size) = slice_end
259 end if
260 if ( present(slice_stride ) ) then
261 ary_size = size(slice_stride)
262 gthstnml % gthstnml_list % slice_stride(1:ary_size) = slice_stride
263 end if
264 if ( present(space_average ) ) then
265 ary_size = size(space_average)
266 gthstnml % gthstnml_list % space_average(1:ary_size) = space_average
267 end if
268 if ( present(newfile_intvalue) ) gthstnml % gthstnml_list % newfile_intvalue = newfile_intvalue
269 if ( present(newfile_intunit ) ) gthstnml % gthstnml_list % newfile_intunit = newfile_intunit
270
271 !-----------------------------------------------------------------
272 ! 時間の単位のチェック
273 ! Check unit of time
274 !-----------------------------------------------------------------
275 call dcdifftimecreate( &
276 & diff = interval_time, & ! (out)
277 & value = &
278 & real( gthstnml % gthstnml_list % interval_value, dp ), & ! (in)
279 & unit = gthstnml % gthstnml_list % interval_unit, & ! (in)
280 & err = err ) ! (out)
281 if ( present_and_true( err ) ) then
282 stat = usr_errno
283 goto 999
284 end if
285
286 !-----------------------------------------------------------------
287 ! 終了処理, 例外処理
288 ! Termination and Exception handling
289 !-----------------------------------------------------------------
290 gthstnml % initialized = .true.
291 gthstnml % define_mode = .true.
292999 continue
293 call storeerror( stat, subname, err, cause_c )
294 call endsub( subname )
295 end subroutine hstnmlinfocreate
subroutine hstnmlinfocreate(gthstnml, interval_value, interval_unit, precision, time_average, average, fileprefix, origin_value, origin_unit, terminus_value, terminus_unit, slice_start, slice_end, slice_stride, space_average, newfile_intvalue, newfile_intunit, err)
Derived types and parameters for date and time.
Date and time manipulation module.
Definition dc_date.f90:57
Error handling module.
Definition dc_error.f90:454
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:891
integer, parameter, public usr_errno
-1000 or less: User-defined errors
Definition dc_error.f90:579
integer, parameter, public dc_ealreadyinit
Definition dc_error.f90:535
integer, parameter, public dc_noerr
Error storage variables
Definition dc_error.f90:468
Judge optional control parameters.
logical function, public present_and_not_empty(arg)
logical function, public present_and_true(arg)
Debug tracing module.
Definition dc_trace.f90:150
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
Definition dc_trace.f90:476
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:599
Provides kind type parameter values.
Definition dc_types.f90:55
integer, parameter, public string
Character length for string
Definition dc_types.f90:137
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:92