Functions/Subroutines
hstnmlinfocreate.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

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)
 

Function/Subroutine Documentation

◆ hstnmlinfocreate()

subroutine hstnmlinfocreate ( type(gthst_nmlinfo), intent(inout)  gthstnml,
real(dp), intent(in), optional  interval_value,
character(*), intent(in), optional  interval_unit,
character(*), intent(in), optional  precision,
logical, intent(in), optional  time_average,
logical, intent(in), optional  average,
character(*), intent(in), optional  fileprefix,
real(dp), intent(in), optional  origin_value,
character(*), intent(in), optional  origin_unit,
real(dp), intent(in), optional  terminus_value,
character(*), intent(in), optional  terminus_unit,
integer, dimension(:), intent(in), optional  slice_start,
integer, dimension(:), intent(in), optional  slice_end,
integer, dimension(:), intent(in), optional  slice_stride,
logical, dimension(:), intent(in), optional  space_average,
integer, intent(in), optional  newfile_intvalue,
character(*), intent(in), optional  newfile_intunit,
logical, intent(out), optional  err 
)

Definition at line 22 of file hstnmlinfocreate.f90.

References dc_trace::beginsub(), dc_error::dc_ealreadyinit, dc_error::dc_earglack, dc_error::dc_enegative, dc_error::dc_enofileread, dc_error::dc_noerr, dc_types::dp, dc_trace::endsub(), dc_string::joinchar(), dc_present::present_and_not_empty(), dc_present::present_and_true(), dc_types::stdout, dc_error::storeerror(), dc_types::string, dc_types::token, dc_error::usr_errno, and gtool_history_nmlinfo_internal::version.

22  !
23  ! GTHST_NMLINFO 型の変数の初期設定を行います.
24  ! 他のサブルーチンを使用する前に必ずこのサブルーチンによって
25  ! GTHST_NMLINFO 型の変数を初期設定してください.
26  !
27  ! *interval_value*,
28  ! *interval_unit*,
29  ! *precision*,
30  ! *time_average* (旧 *average*) などの変数
31  ! はデフォルト値として設定されます.
32  ! *fileprefix* は各変数の出力ファイル名の接頭詞として
33  ! 使用されます.
34  !
35  ! なお, 与えられた *gthstnml* が既に初期設定されている場合,
36  ! プログラムはエラーを発生させます.
37  !
38  ! Constructor of "GTHST_NMLINFO".
39  ! Initialize *gthstnml* by this subroutine,
40  ! before other procedures are used,
41  !
42  ! *interval_value*,
43  ! *interval_unit*,
44  ! *precision*,
45  ! *time_average* (now-defunct *average*), etc.
46  ! are set as default values.
47  ! *fileprefix* is used as prefixes of output filenames of
48  ! each variable.
49  !
50  ! Note that if *gthstnml* is already initialized
51  ! by this procedure, error is occurred.
52  !
53  use gtool_history_nmlinfo_types, only: gthst_nmlinfo
54  use gtool_history_nmlinfo_internal, only: version
55  use gtool_history, only: gt_history
56  use dc_trace, only: beginsub, endsub
57  use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
58  use dc_types, only: dp, string, token, stdout
59  use dc_present, only: present_and_not_empty, present_and_true, present_select
60  use dc_message, only: messagenotify
61  use dc_error, only: storeerror, dc_noerr, dc_ealreadyinit, &
62  & dc_earglack, dc_enegative, dc_enofileread, usr_errno
63  use dc_date_types, only: dc_difftime
64  use dc_date, only: dcdifftimecreate
65  use netcdf, only: nf90_max_dims
66  implicit none
67  type(gthst_nmlinfo), intent(inout):: gthstnml
68  real(DP), intent(in), optional:: interval_value
69  ! ヒストリデータの出力間隔の数値.
70  ! 負の値を与えると, 出力を抑止します.
71  !
72  ! Numerical value for interval of history data output.
73  ! Negative values suppresses output.
74  character(*), intent(in), optional:: interval_unit
75  ! ヒストリデータの出力間隔の単位.
76  ! Unit for interval of history data output
77  character(*), intent(in), optional:: precision
78  ! ヒストリデータの精度.
79  ! Precision of history data
80  logical, intent(in), optional:: time_average
81  ! 出力データの時間平均化フラグ.
82  ! Flag for time average of output data.
83  logical, intent(in), optional:: average
84  ! time_average の旧版.
85  ! Old version of "time_average"
86  character(*), intent(in), optional:: fileprefix
87  ! ヒストリデータのファイル名の接頭詞.
88  ! Prefixes of history data filenames
89  real(DP), intent(in), optional:: origin_value
90  ! 出力開始時刻.
91  ! Start time of output.
92  character(*), intent(in), optional:: origin_unit
93  ! 出力開始時刻の単位.
94  ! Unit of start time of output.
95  real(DP), intent(in), optional:: terminus_value
96  ! 出力終了時刻.
97  ! End time of output.
98  character(*), intent(in), optional:: terminus_unit
99  ! 出力終了時刻の単位.
100  ! Unit of end time of output.
101  integer, intent(in), optional:: slice_start(:)
102  ! 空間方向の開始点.
103  ! Start points of spaces.
104  integer, intent(in), optional:: slice_end(:)
105  ! 空間方向の終了点.
106  ! End points of spaces.
107  integer, intent(in), optional:: slice_stride(:)
108  ! 空間方向の刻み幅.
109  ! Strides of spaces.
110  logical, intent(in), optional:: space_average(:)
111  ! 平均化のフラグ.
112  ! Flag of average.
113  integer, intent(in), optional:: newfile_intvalue
114  ! ファイル分割時間間隔.
115  ! Interval of time of separation of a file.
116  character(*), intent(in), optional:: newfile_intunit
117  ! ファイル分割時間間隔の単位.
118  ! Unit of interval of time of separation of a file.
119  logical, intent(out), optional:: err
120  ! 例外処理用フラグ.
121  ! デフォルトでは, この手続き内でエラーが
122  ! 生じた場合, プログラムは強制終了します.
123  ! 引数 *err* が与えられる場合,
124  ! プログラムは強制終了せず, 代わりに
125  ! *err* に .true. が代入されます.
126  !
127  ! Exception handling flag.
128  ! By default, when error occur in
129  ! this procedure, the program aborts.
130  ! If this *err* argument is given,
131  ! .true. is substituted to *err* and
132  ! the program does not abort.
133 
134  !-----------------------------------
135  ! 作業変数
136  ! Work variables
137  type(dc_difftime):: interval_time
138  integer:: stat, ary_size
139  character(STRING):: cause_c
140  character(*), parameter:: subname = 'HstNmlInfoCreate'
141  continue
142  call beginsub( subname, &
143  & fmt = '@interval_value=%r @interval_unit=%c @precision=%c @time_average=%y @fileprefix=%c', &
144  & d = (/ present_select(.true., -1.0_dp, interval_value) /), &
145  & c1 = trim( present_select(.true., '<no>', interval_unit) ), &
146  & c2 = trim( present_select(.true., '<no>', precision) ), &
147  & l = (/ present_and_true(time_average) /), &
148  & c3 = trim( present_select(.true., '<no>', fileprefix) ), &
149  & version = version )
150  stat = dc_noerr
151  cause_c = ''
152 
153  !-----------------------------------------------------------------
154  ! 初期設定のチェック
155  ! Check initialization
156  !-----------------------------------------------------------------
157  if ( gthstnml % initialized ) then
158  stat = dc_ealreadyinit
159  cause_c = 'GTHST_NMLINFO'
160  goto 999
161  end if
162 
163  !-----------------------------------------------------------------
164  ! 割付
165  ! Allocate
166  !-----------------------------------------------------------------
167  allocate( gthstnml % gthstnml_list )
168  nullify( gthstnml % gthstnml_list % next )
169 
170  !-----------------------------------------------------------------
171  ! デフォルト値の設定
172  ! Configure default values
173  !-----------------------------------------------------------------
174  gthstnml % gthstnml_list % name = ''
175  gthstnml % gthstnml_list % file = ''
176 
177  allocate( gthstnml % gthstnml_list % interval_value )
178  allocate( gthstnml % gthstnml_list % interval_unit )
179  allocate( gthstnml % gthstnml_list % precision )
180  allocate( gthstnml % gthstnml_list % time_average )
181  allocate( gthstnml % gthstnml_list % fileprefix )
182 
183  allocate( gthstnml % gthstnml_list % origin_value )
184  allocate( gthstnml % gthstnml_list % origin_unit )
185  allocate( gthstnml % gthstnml_list % terminus_value )
186  allocate( gthstnml % gthstnml_list % terminus_unit )
187  allocate( gthstnml % gthstnml_list % slice_start (1:nf90_max_dims) )
188  allocate( gthstnml % gthstnml_list % slice_end (1:nf90_max_dims) )
189  allocate( gthstnml % gthstnml_list % slice_stride (1:nf90_max_dims) )
190  allocate( gthstnml % gthstnml_list % space_average (1:nf90_max_dims) )
191  allocate( gthstnml % gthstnml_list % newfile_intvalue )
192  allocate( gthstnml % gthstnml_list % newfile_intunit )
193 
194 
195  gthstnml % gthstnml_list % interval_value = -1.0
196  gthstnml % gthstnml_list % interval_unit = 'sec'
197  gthstnml % gthstnml_list % precision = 'float'
198  gthstnml % gthstnml_list % time_average = .false.
199  gthstnml % gthstnml_list % fileprefix = ''
200 
201  gthstnml % gthstnml_list % origin_value = -1.0
202  gthstnml % gthstnml_list % origin_unit = 'sec'
203  gthstnml % gthstnml_list % terminus_value = -1.0
204  gthstnml % gthstnml_list % terminus_unit = 'sec'
205  gthstnml % gthstnml_list % slice_start = 1
206  gthstnml % gthstnml_list % slice_end = -1
207  gthstnml % gthstnml_list % slice_stride = 1
208  gthstnml % gthstnml_list % space_average = .false.
209  gthstnml % gthstnml_list % newfile_intvalue = -1
210  gthstnml % gthstnml_list % newfile_intunit = 'sec'
211 
212  if ( present(interval_value) ) gthstnml % gthstnml_list % interval_value = interval_value
213  if ( present(interval_unit) ) gthstnml % gthstnml_list % interval_unit = interval_unit
214  if ( present(precision) ) gthstnml % gthstnml_list % precision = precision
215 
216  if ( present(average) ) gthstnml % gthstnml_list % time_average = average
217  if ( present(time_average) ) gthstnml % gthstnml_list % time_average = time_average
218  if ( present(fileprefix) ) gthstnml % gthstnml_list % fileprefix = fileprefix
219 
220  if ( present(origin_value ) ) gthstnml % gthstnml_list % origin_value = origin_value
221  if ( present(origin_unit ) ) gthstnml % gthstnml_list % origin_unit = origin_unit
222  if ( present(terminus_value ) ) gthstnml % gthstnml_list % terminus_value = terminus_value
223  if ( present(terminus_unit ) ) gthstnml % gthstnml_list % terminus_unit = terminus_unit
224  if ( present(slice_start ) ) then
225  ary_size = size(slice_start)
226  gthstnml % gthstnml_list % slice_start(1:ary_size) = slice_start
227  end if
228  if ( present(slice_end ) ) then
229  ary_size = size(slice_end)
230  gthstnml % gthstnml_list % slice_end(1:ary_size) = slice_end
231  end if
232  if ( present(slice_stride ) ) then
233  ary_size = size(slice_stride)
234  gthstnml % gthstnml_list % slice_stride(1:ary_size) = slice_stride
235  end if
236  if ( present(space_average ) ) then
237  ary_size = size(space_average)
238  gthstnml % gthstnml_list % space_average(1:ary_size) = space_average
239  end if
240  if ( present(newfile_intvalue) ) gthstnml % gthstnml_list % newfile_intvalue = newfile_intvalue
241  if ( present(newfile_intunit ) ) gthstnml % gthstnml_list % newfile_intunit = newfile_intunit
242 
243  !-----------------------------------------------------------------
244  ! 時間の単位のチェック
245  ! Check unit of time
246  !-----------------------------------------------------------------
247  call dcdifftimecreate( &
248  & diff = interval_time, & ! (out)
249  & value = &
250  & real( gthstnml % gthstnml_list % interval_value, DP ), & ! (in)
251  & unit = gthstnml % gthstnml_list % interval_unit, & ! (in)
252  & err = err ) ! (out)
253  if ( present_and_true( err ) ) then
254  stat = usr_errno
255  goto 999
256  end if
257 
258  !-----------------------------------------------------------------
259  ! 終了処理, 例外処理
260  ! Termination and Exception handling
261  !-----------------------------------------------------------------
262  gthstnml % initialized = .true.
263  gthstnml % define_mode = .true.
264 999 continue
265  call storeerror( stat, subname, err, cause_c )
266  call endsub( subname )
dc_trace
Definition: dc_trace.f90:11
dc_error::dc_earglack
integer, parameter, public dc_earglack
Definition: dc_error.f90:569
dc_error::usr_errno
integer, parameter, public usr_errno
Definition: dc_error.f90:604
dc_string::strinclude
Definition: dc_string.f90:158
dc_error
Definition: dc_error.f90:11
dc_date_generic::dcdifftimecreate
Definition: dc_date_generic.f90:230
dc_error::dc_enofileread
integer, parameter, public dc_enofileread
Definition: dc_error.f90:566
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_present::present_and_true
logical function, public present_and_true(arg)
Definition: dc_present.f90:80
gtool_history
Definition: gtool_history.f90:12
dc_message
Definition: dc_message.f90:9
dc_error::storeerror
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition: dc_error.f90:830
gtool_history_nmlinfo_types::gthst_nmlinfo
Definition: gtool_history_nmlinfo_types.f90:42
dc_error::dc_noerr
integer, parameter, public dc_noerr
Definition: dc_error.f90:509
dc_present
Definition: dc_present.f90:26
dc_string::joinchar
character(string) function, public joinchar(carray, expr)
Definition: dc_string.f90:861
dc_string::printf
Definition: dc_string.f90:186
gtool_history_nmlinfo_internal::version
character(*), parameter, public version
Definition: gtool_history_nmlinfo_internal.f90:34
dc_date_types
Definition: dc_date_types.f90:10
dc_types::dp
integer, parameter, public dp
倍精度実数型変数
Definition: dc_types.f90:83
gtool_history_nmlinfo_types
Definition: gtool_history_nmlinfo_types.f90:11
dc_present::present_and_not_empty
logical function, public present_and_not_empty(arg)
Definition: dc_present.f90:276
dc_trace::beginsub
subroutine, public beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, version)
Definition: dc_trace.f90:351
gtool_history_types::gt_history
Definition: gtool_history_types.f90:42
dc_present::present_select
Definition: dc_present.f90:66
dc_types::stdout
integer, parameter, public stdout
標準出力の装置番号
Definition: dc_types.f90:98
dc_string
文字型変数の操作.
Definition: dc_string.f90:24
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
gtdata_generic::putline
Definition: gtdata_generic.f90:744
dc_string::stoa
Definition: dc_string.f90:101
dc_date
Definition: dc_date.f90:9
dc_message::messagenotify
Definition: dc_message.f90:40
dc_trace::endsub
subroutine, public endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:446
gtool_history_nmlinfo_internal
Definition: gtool_history_nmlinfo_internal.f90:11
dc_error::dc_ealreadyinit
integer, parameter, public dc_ealreadyinit
Definition: dc_error.f90:558
dc_date_types::dc_difftime
Definition: dc_date_types.f90:194
dc_error::dc_enegative
integer, parameter, public dc_enegative
Definition: dc_error.f90:568
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118
dc_string::split
Definition: dc_string.f90:118
Here is the call graph for this function: