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
98
99 character(*), intent(in), optional:: interval_unit
100
101
102 character(*), intent(in), optional:: precision
103
104
105 logical, intent(in), optional:: time_average
106
107
108 logical, intent(in), optional:: average
109
110
111 character(*), intent(in), optional:: fileprefix
112
113
114 real(DP), intent(in), optional:: origin_value
115
116
117 character(*), intent(in), optional:: origin_unit
118
119
120 real(DP), intent(in), optional:: terminus_value
121
122
123 character(*), intent(in), optional:: terminus_unit
124
125
126 integer, intent(in), optional:: slice_start(:)
127
128
129 integer, intent(in), optional:: slice_end(:)
130
131
132 integer, intent(in), optional:: slice_stride(:)
133
134
135 logical, intent(in), optional:: space_average(:)
136
137
138 integer, intent(in), optional:: newfile_intvalue
139
140
141 character(*), intent(in), optional:: newfile_intunit
142
143
144 logical, intent(out), optional:: err
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162 type(DC_DIFFTIME):: interval_time
163 integer:: stat, ary_size
164 character(STRING):: cause_c
165 character(*), parameter:: subname = 'HstNmlInfoCreate'
166 continue
168 & fmt = '@interval_value=%r @interval_unit=%c @precision=%c @time_average=%y @fileprefix=%c', &
176 cause_c = ''
177
178
179
180
181
182 if ( gthstnml % initialized ) then
184 cause_c = 'GTHST_NMLINFO'
185 goto 999
186 end if
187
188
189
190
191
192 allocate( gthstnml % gthstnml_list )
193 nullify( gthstnml % gthstnml_list % next )
194
195
196
197
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
274
275 call dcdifftimecreate( &
276 & diff = interval_time, &
277 & value = &
278 & real( gthstnml % gthstnml_list % interval_value,
dp ), &
279 & unit = gthstnml % gthstnml_list % interval_unit, &
280 & err = err )
283 goto 999
284 end if
285
286
287
288
289
290 gthstnml % initialized = .true.
291 gthstnml % define_mode = .true.
292999 continue
293 call storeerror( stat, subname, err, cause_c )
Derived types and parameters for date and time.
Date and time manipulation module.
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public usr_errno
-1000 or less: User-defined errors
integer, parameter, public dc_noerr
Error storage variables
integer, parameter, public dc_ealreadyinit
Judge optional control parameters.
logical function, public present_and_not_empty(arg)
logical function, public present_and_true(arg)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Provides kind type parameter values.
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string
character(*), parameter, public version