gtool5 Fortran 90/95 ライブラリ 1.0.0-rc5
English
Loading...
Searching...
No Matches
historyautoaddvariable.f90
Go to the documentation of this file.
1!--
2! *** Caution!! ***
3!
4! This file is generated from "historyautoaddvariable.rb2f90" by Ruby 3.3.8.
5! Please do not edit this file directly.
6!
7! [JAPANESE]
8!
9! ※※※ 注意!!! ※※※
10!
11! このファイルは "historyautoaddvariable.rb2f90" から Ruby 3.3.8
12! によって自動生成されたファイルです.
13! このファイルを直接編集しませんようお願い致します.
14!
15!
16!++
30
129 & varname, dims, longname, units, & ! (in)
130 & xtype, time_units, time_average, & ! (in) optional
131 & file, & ! (in) optional
132 & origin, terminus, interval, & ! (in) optional
133 & slice_start, slice_end, slice_stride, & ! (in) optional
134 & space_average, & ! (in) optional
135 & newfile_interval & ! (in) optional
136 & )
137
138 ! モジュール引用 ; USE statements
139 !
140
143 & numvars, numwgts, &
155 use gtool_history, only: historyvarinfocreate, historyvarinfoinquire, &
156 & historyaxisinquire
157 use dc_trace, only: beginsub, endsub
160 use dc_message, only: messagenotify
162 use dc_calendar, only: dccalconvertbyunit, dccalparseunit
163 use dc_date, only: dcdifftimecreate, operator(/), mod, evalsec, &
164 & operator(-), evalbyunit
166 use netcdf, only: nf90_emaxvars, nf90_max_dims
167 use dc_types, only: dp, string, token
168
169 ! 宣言文 ; Declaration statements
170 !
171 implicit none
172 character(*), intent(in):: varname
173 ! 変数名. Variable name
174 character(*), intent(in):: dims(:)
175 ! 変数が依存する次元の名前.
176 ! 時間の次元は配列の最後に指定すること.
177 !
178 ! Names of dependency dimensions of a variable.
179 ! Dimension of time must be specified
180 ! to last of an array.
181 character(*), intent(in):: longname
182 ! 変数の記述的名称.
183 !
184 ! Descriptive name of a variable
185 character(*), intent(in):: units
186 ! 変数の単位.
187 !
188 ! Units of a variable
189 character(*), intent(in), optional:: xtype
190 !
191 ! 変数のデータ型
192 !
193 ! デフォルトは float (単精度実数型) であ
194 ! る. 有効なのは, double (倍精度実数型),
195 ! int (整数型) である. 指定しない 場合や,
196 ! 無効な型を指定した場合には, float (単
197 ! 精度実数型) となる.
198 !
199 ! Data types of dimensions specified
200 ! with "dims".
201 !
202 ! Default value is "float" (single precision).
203 ! Other valid values are
204 ! "double" (double precision),
205 ! "int" (integer).
206 ! If no value or invalid value is specified,
207 ! "float" is applied.
208 !
209 character(*), intent(in), optional:: time_units
210 ! 時刻次元の単位.
211 ! Units of time dimension.
212 logical, intent(in), optional:: time_average
213 !
214 ! 出力データを時間平均する場合には
215 ! .true. を与えます. デフォルトは
216 ! .false. です.
217 !
218 ! If output data is averaged, specify
219 ! ".true.". Default is ".false.".
220 !
221 character(*), intent(in), optional:: file
222 ! 出力ファイル名.
223 ! Output file name.
224
225 real(DP), intent(in), optional:: origin
226 ! 出力開始時刻.
227 !
228 ! 省略した場合, 自動的に 0.0 [sec] が
229 ! 設定されます.
230 !
231 ! Start time of output.
232 !
233 ! If this argument is omitted,
234 ! 0.0 [sec] is specified
235 ! automatically.
236 !
237 real(DP), intent(in), optional:: terminus
238 ! 出力終了時刻.
239 !
240 ! 省略した場合, 数値モデルの実行が終了するまで
241 ! 出力を行います.
242 !
243 ! End time of output.
244 !
245 ! If this argument is omitted,
246 ! output is continued until a numerical model
247 ! is finished.
248 !
249 real(DP), intent(in), optional:: interval
250 ! 出力時間間隔.
251 !
252 ! 省略した場合,
253 ! 自動的に 1.0 [sec] が設定されます.
254 !
255 ! Interval of output time.
256 !
257 ! If this argument is omitted,
258 ! a value of 1.0 [sec] is specified
259 ! automatically.
260 !
261 integer, intent(in), optional:: slice_start(:)
262 ! 空間方向の開始点.
263 !
264 ! 省略した場合, 座標データの開始点が設定されます.
265 !
266 ! Start points of spaces.
267 !
268 ! If this argument is omitted,
269 ! start points of dimensions are set.
270 !
271 integer, intent(in), optional:: slice_end(:)
272 ! 空間方向の終了点.
273 !
274 ! 省略した場合, 座標データの終了点が設定されます.
275 !
276 ! End points of spaces.
277 !
278 ! If this argument is omitted,
279 ! End points of dimensions are set.
280 !
281 integer, intent(in), optional:: slice_stride(:)
282 ! 空間方向の刻み幅.
283 !
284 ! 省略した場合, 1 が設定されます.
285 !
286 ! Strides of spaces
287 !
288 ! If this argument is omitted,
289 ! 1 is set.
290 !
291 logical, intent(in), optional:: space_average(:)
292 ! 平均化のフラグ.
293 !
294 ! .true. が指定される座標に対して平均化を
295 ! 行います.
296 ! 省略した場合, .false. が設定されます.
297 !
298 ! Flag of average.
299 !
300 ! Axes specified .true. are averaged.
301 ! If this argument is omitted,
302 ! .false. is set.
303 !
304 integer, intent(in), optional:: newfile_interval
305 ! ファイル分割時間間隔.
306 !
307 ! 省略した場合,
308 ! 時間方向へのファイル分割を行いません.
309 !
310 ! Interval of time of separation of a file.
311 !
312 ! If this argument is omitted,
313 ! a files is not separated in time direction.
314 !
315
316 ! 作業変数
317 ! Work variables
318 !
319 character(TOKEN):: interval_unit_work
320 ! データの出力間隔の単位.
321 ! Unit for interval of history data output
322 character(TOKEN):: origin_unit_work
323 ! 出力開始時刻の単位.
324 ! Unit of start time of output.
325 character(TOKEN):: terminus_unit_work
326 ! 出力終了時刻の単位.
327 ! Unit of end time of output.
328 character(TOKEN):: newfile_intunit_work
329 ! ファイル分割時間間隔の単位.
330 ! Unit of interval of time of separation of a file.
331
332 real(DP):: interval_value
333 ! データの出力間隔の数値.
334 ! Numerical value for interval of history data output
335 real(DP):: origin_value
336 ! データの出力開始時刻の数値.
337 ! Numerical value for start time of history data output
338 real(DP):: terminus_value
339 ! 出力終了時刻の数値.
340 ! Numerical value for end time of output.
341 integer:: newfile_intvalue
342 ! ファイル分割時間間隔.
343 ! Interval of time of separation of a file.
344 character(TOKEN):: time_name
345 ! 時刻次元の名称.
346 ! Name of time dimension
347 character(STRING), allocatable:: dims_work(:)
348 ! 変数が依存する次元の名前.
349 ! Names of dependency dimensions of a variable.
350 character(TOKEN):: precision
351 ! データの精度.
352 ! Precision of history data
353 logical:: time_average_work
354 ! 出力データの時間平均フラグ.
355 ! Flag for time average of output data
356 logical:: space_average_work(1:numdims-1)
357 integer:: slice_start_work(1:numdims-1)
358 ! 空間方向の開始点.
359 ! Start points of spaces.
360 integer:: slice_end_work(1:numdims-1)
361 ! 空間方向の終了点.
362 ! End points of spaces.
363 integer:: slice_stride_work(1:numdims-1)
364 ! 空間方向の刻み幅.
365 ! Strides of spaces
366
367 logical:: define_mode, varname_not_found
368 integer:: cause_i, stat, i, j, k, cnt, cnt2, dim_size
369 character(STRING), pointer:: dims_noavr(:) =>null(), dims_avr(:) =>null()
370 character(STRING):: longname_avrmsg
371 character(STRING):: name, cause_c
372 character(*), parameter:: subname = "HistoryAutoAddVariable1"
373 continue
374 call beginsub(subname, 'varname=%c', c1 = trim(varname), version = version)
375 stat = dc_noerr
376 cause_c = ""
377 cause_i = 0
378
379 ! 初期設定チェック
380 ! Check initialization
381 !
382 if ( .not. initialized ) then
383 stat = dc_enotinit
384 cause_c = 'gtool_historyauto'
385 goto 999
386 end if
387
388 ! 既に HistoryAutoAllVarFix が呼ばれていたらエラー
389 ! Error is occurred if "HistoryAutoAllVarFix" is called already
390 !
391 if ( flag_allvarfixed ) then
392 call messagenotify( 'W', subname, &
393 & '"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoAllVarFix"', &
394 & c1 = trim(varname) )
396 cause_c = 'HistoryAutoAllVarFix'
397 goto 999
398 end if
399
400 ! 重複のチェック
401 ! Check duplication
402 !
403 do i = 1, numvars
404 call historyvarinfoinquire( &
405 & varinfo = gthst_vars(i), & ! (in)
406 & name = name ) ! (out)
407 if ( trim(varname) == trim(name) ) then
408 stat = hst_evarinuse
409 cause_c = varname
410 goto 999
411 end if
412 end do
413
414 ! 変数の数の限界チェック
415 ! Check limit of number of variables
416 !
417 if ( numvars + 1 > max_vars ) then
418 stat = nf90_emaxvars
419 goto 999
420 end if
421
422 ! 時刻の次元に関する修正
423 ! Correction for time dimension
424 !
425 call historyaxisinquire( &
426 & axis = gthst_axes(numdims), & ! (in)
427 & name = time_name ) ! (out)
428
429 if ( size(dims) > 0 ) then
430 if ( strinclude( dims, time_name ) ) then
431 if ( trim( dims(size(dims)) ) == trim( time_name ) ) then
432 allocate( dims_work(size(dims)) )
433 dims_work = dims
434 else
435 allocate( dims_work(size(dims)) )
436 cnt = 1
437 do i = 1, size(dims)
438 if ( trim( dims(i) ) /= trim( time_name ) ) then
439 dims_work( cnt ) = dims( i )
440 cnt = cnt + 1
441 end if
442 end do
443 dims_work(size(dims)) = time_name
444
445 call messagenotify( 'W', subname, &
446 & 'last entity of "dims=<%c>" must be time dimension (varname=<%c>). ' // &
447 & ' "dims" are resequenced forcibly => <%c>', &
448 & c1 = trim( joinchar(dims, ',') ), c2 = trim( varname ), &
449 & c3 = trim( joinchar(dims_work, ',') ) )
450
451 end if
452 else
453 allocate( dims_work(size(dims)+1) )
454 dims_work(1:size(dims)) = dims
455 dims_work(size(dims)+1) = time_name
456 call messagenotify( 'W', subname, &
457 & 'time dimension is not found in "dims=<%c>" (varname=<%c>). ' // &
458 & ' time dimension "%c" is appended to "dims" forcibly.', &
459 & c1 = trim( joinchar(dims, ',') ), c2 = trim( varname ), &
460 & c3 = trim( time_name ) )
461 end if
462 else
463 allocate( dims_work(1) )
464 dims_work(1) = time_name
465 call messagenotify( 'W', subname, &
466 & 'time dimension is not found (varname=<%c>). ' // &
467 & ' time dimension "%c" is appended to "dims" forcibly.', &
468 & c1 = trim( varname ), &
469 & c2 = trim( time_name ) )
470 end if
471
472 ! 依存する次元の数の限界チェック
473 ! Check limit of number of depended dimensions
474 !
475 if ( size( dims_work ) - 1 > max_dims_depended_by_var ) then
476 call messagenotify( 'W', subname, &
477 & 'number of dimensions' // &
478 & ' on which one variable depends must not be greater than %d (varname=<%c>, dims=<%c>). ', &
479 & i = (/ 7 + 1 /), &
480 & c1 = trim( varname ), c2 = trim( joinchar(dims_work, ',') ) )
482 cause_i = size( dims_work )
483 cause_c = varname
484 end if
485
486 ! 全ての変数を出力する際には, ここで登録
487 ! Register here if all variables are output
488 !
489 if ( all_output_save ) then
490 call hstnmlinfoinquire( &
491 & gthstnml = gthstnml, name = varname, & ! (in)
492 & err = varname_not_found ) ! (out) optional
493 if ( varname_not_found ) then
494 define_mode = hstnmlinfodefinemode( gthstnml )
495 if ( .not. define_mode ) call hstnmlinforedefine( gthstnml ) ! (inout)
496
497 call hstnmlinfoinquire( &
498 & gthstnml = gthstnml, & ! (in)
499 & interval_unit = interval_unit_work, & ! (out) optional
500 & origin_unit = origin_unit_work , & ! (out) optional
501 & terminus_unit = terminus_unit_work, & ! (out) optional
502 & newfile_intunit = newfile_intunit_work ) ! (out) optional
503
504 ! 時刻の単位を設定
505 ! Configure unit of time
506 !
507 if ( present( interval ) ) then
508 interval_unit_work = time_unit_bycreate
509 if ( present(time_units) ) interval_unit_work = time_units
510 end if
511 if ( present( origin ) ) then
512 origin_unit_work = time_unit_bycreate
513 if ( present(time_units) ) origin_unit_work = time_units
514 end if
515 if ( present( terminus ) ) then
516 terminus_unit_work = time_unit_bycreate
517 if ( present(time_units) ) terminus_unit_work = time_units
518 end if
519 if ( present( newfile_interval ) ) then
520 newfile_intunit_work = time_unit_bycreate
521 if ( present(time_units) ) newfile_intunit_work = time_units
522 end if
523
524 call hstnmlinfoadd( &
525 & gthstnml = gthstnml, & ! (inout)
526 & name = varname, & ! (in) optional
527 & file = file, & ! (in) optional
528 & precision = xtype, & ! (in) optional
529 & interval_value = interval, & ! (in) optional
530 & interval_unit = interval_unit_work, & ! (in) optional
531 & origin_value = origin, & ! (in) optional
532 & origin_unit = origin_unit_work, & ! (in) optional
533 & terminus_value = terminus, & ! (in) optional
534 & terminus_unit = terminus_unit_work, & ! (in) optional
535 & slice_start = slice_start, & ! (in) optional
536 & slice_end = slice_end, & ! (in) optional
537 & slice_stride = slice_stride, & ! (in) optional
538 & time_average = time_average, & ! (in) optional
539 & space_average = space_average, & ! (in) optional
540 & newfile_intvalue = newfile_interval, & ! (in) optional
541 & newfile_intunit = newfile_intunit_work ) ! (in) optional
542 if ( .not. define_mode ) call hstnmlinfoenddefine( gthstnml ) ! (inout)
543 end if
544 end if
545
546 ! 平均化に伴う次元の縮退を反映した変数情報の作り直し
547 ! Remake information of variables that reflects reduction of dimensions
548 ! correspond to average
549 !
550 call hstnmlinfoinquire( &
551 & gthstnml = gthstnml, name = varname, & ! (in)
552 & precision = precision, & ! (out) optional
553 & time_average = time_average_work, & ! (out) optional
554 & space_average = space_average_work, & ! (out) optional
555 & slice_start = slice_start_work, & ! (out)
556 & slice_end = slice_end_work, & ! (out)
557 & slice_stride = slice_stride_work, & ! (out)
558 & err = varname_not_found ) ! (out) optional
559 if ( varname_not_found ) then
560 call hstnmlinfoinquire( &
561 & gthstnml = gthstnml, name = '', & ! (in)
562 & precision = precision, & ! (out) optional
563 & time_average = time_average_work, & ! (out) optional
564 & space_average = space_average_work, & ! (out) optional
565 & slice_start = slice_start_work, & ! (out)
566 & slice_end = slice_end_work, & ! (out)
567 & slice_stride = slice_stride_work ) ! (out)
568 end if
569
570 if ( .not. associated( space_avr_vars(numvars + 1) % avr ) ) &
571 & allocate( space_avr_vars(numvars + 1) % avr( size( dims_work ) - 1 ) )
572
573 space_avr_vars(numvars + 1) % avr = .false.
574 do i = 1, size( dims_work ) - 1
575 do j = 1, numdims - 1
576 call historyaxisinquire( &
577 & axis = gthst_axes(j), & ! (in)
578 & name = name ) ! (out)
579 if ( trim(dims_work(i)) == trim(name) ) then
580 space_avr_vars(numvars + 1) % avr( i ) = space_average_work( j )
581 exit
582 end if
583 end do
584 end do
585
586 allocate( dims_noavr( size(dims_work) - count(space_avr_vars(numvars + 1) % avr) ) )
587 if ( count(space_avr_vars(numvars + 1) % avr) < 1 ) then
588 dims_noavr = dims_work
589 longname_avrmsg = ''
590 else
591 allocate( dims_avr( count(space_avr_vars(numvars + 1) % avr) ) )
592 cnt = 1 ; cnt2 = 1
593 do i = 1, size( dims_work ) - 1
594 if ( .not. space_avr_vars(numvars + 1) % avr(i) ) then
595 dims_noavr( cnt ) = dims_work( i )
596 cnt = cnt + 1
597 else
598 dims_avr( cnt2 ) = dims_work( i )
599 cnt2 = cnt2 + 1
600 end if
601 end do
602 dims_noavr( cnt ) = dims_work( size ( dims_work ) )
603
604 longname_avrmsg = ' averaged in ' // trim( joinchar( dims_avr, ',' ) ) // '-direction'
605 deallocate( dims_avr )
606 end if
607
608 ! HistoryPut の際のデータの切り出し情報作成
609 ! Create information of slices of data for "HistoryPut"
610 !
611 if ( .not. associated( slice_vars(numvars + 1) % st ) ) &
612 & allocate( slice_vars(numvars + 1) % st( nf90_max_dims ) )
613 if ( .not. associated( slice_vars(numvars + 1) % ed ) ) &
614 & allocate( slice_vars(numvars + 1) % ed( nf90_max_dims ) )
615 if ( .not. associated( slice_vars(numvars + 1) % sd ) ) &
616 & allocate( slice_vars(numvars + 1) % sd( nf90_max_dims ) )
617 slice_vars(numvars + 1) % st = 1
618 slice_vars(numvars + 1) % ed = 1
619 slice_vars(numvars + 1) % sd = 1
620
621 if ( size(dims_work) > 1 ) then
622 slice_subscript_search: do i = 1, size( dims_work ) - 1
623 do j = 1, numdims - 1
624 call historyaxisinquire( &
625 & axis = gthst_axes(j), & ! (in)
626 & name = name, & ! (out)
627 & size = dim_size ) ! (out)
628 if ( slice_end_work(j) < 1 ) slice_end_work(j) = dim_size
629 if ( trim(dims_work(i)) == trim(name) ) then
630 slice_vars(numvars + 1) % st( i ) = slice_start_work( j )
631 slice_vars(numvars + 1) % ed( i ) = slice_end_work( j )
632 slice_vars(numvars + 1) % sd( i ) = slice_stride_work( j )
633 cycle slice_subscript_search
634 end if
635 end do
636 end do slice_subscript_search
637 end if
638
639
640 ! HistoryPut の際の座標重み情報作成
641 ! Create information of axes weight for "HistoryPut"
642 !
643
644 if ( .not. associated( weight_vars(numvars + 1) % wgt1 ) ) &
645 & allocate( weight_vars(numvars + 1) % wgt1( 1 ) )
646 weight_vars(numvars + 1) % wgt1 = 1.0_dp
647
648 if ( size(dims_work) >= 1 ) then
649 do j = 1, numdims - 1
650 call historyaxisinquire( &
651 & axis = gthst_axes(j), & ! (in)
652 & name = name, & ! (out)
653 & size = dim_size ) ! (out)
654 if ( trim(dims_work(1)) == trim(name) ) then
655 deallocate( weight_vars(numvars + 1) % wgt1 )
656 allocate( weight_vars(numvars + 1) % wgt1( dim_size ) )
657 weight_vars(numvars + 1) % wgt1 = 1.0_dp
658 do k = 1, numwgts
659 call historyvarinfoinquire( &
660 & varinfo = gthst_weights(k), & ! (in)
661 & name = name ) ! (out)
662 if ( trim(dims_work(1)) // wgtsuf == trim(name) ) then
663 weight_vars(numvars + 1) % wgt1 = data_weights( k ) % a_axis
664 exit
665 end if
666 end do
667 exit
668 end if
669 end do
670 end if
671
672
673
674 if ( .not. associated( weight_vars(numvars + 1) % wgt2 ) ) &
675 & allocate( weight_vars(numvars + 1) % wgt2( 1 ) )
676 weight_vars(numvars + 1) % wgt2 = 1.0_dp
677
678 if ( size(dims_work) >= 2 ) then
679 do j = 1, numdims - 1
680 call historyaxisinquire( &
681 & axis = gthst_axes(j), & ! (in)
682 & name = name, & ! (out)
683 & size = dim_size ) ! (out)
684 if ( trim(dims_work(2)) == trim(name) ) then
685 deallocate( weight_vars(numvars + 1) % wgt2 )
686 allocate( weight_vars(numvars + 1) % wgt2( dim_size ) )
687 weight_vars(numvars + 1) % wgt2 = 1.0_dp
688 do k = 1, numwgts
689 call historyvarinfoinquire( &
690 & varinfo = gthst_weights(k), & ! (in)
691 & name = name ) ! (out)
692 if ( trim(dims_work(2)) // wgtsuf == trim(name) ) then
693 weight_vars(numvars + 1) % wgt2 = data_weights( k ) % a_axis
694 exit
695 end if
696 end do
697 exit
698 end if
699 end do
700 end if
701
702
703
704 if ( .not. associated( weight_vars(numvars + 1) % wgt3 ) ) &
705 & allocate( weight_vars(numvars + 1) % wgt3( 1 ) )
706 weight_vars(numvars + 1) % wgt3 = 1.0_dp
707
708 if ( size(dims_work) >= 3 ) then
709 do j = 1, numdims - 1
710 call historyaxisinquire( &
711 & axis = gthst_axes(j), & ! (in)
712 & name = name, & ! (out)
713 & size = dim_size ) ! (out)
714 if ( trim(dims_work(3)) == trim(name) ) then
715 deallocate( weight_vars(numvars + 1) % wgt3 )
716 allocate( weight_vars(numvars + 1) % wgt3( dim_size ) )
717 weight_vars(numvars + 1) % wgt3 = 1.0_dp
718 do k = 1, numwgts
719 call historyvarinfoinquire( &
720 & varinfo = gthst_weights(k), & ! (in)
721 & name = name ) ! (out)
722 if ( trim(dims_work(3)) // wgtsuf == trim(name) ) then
723 weight_vars(numvars + 1) % wgt3 = data_weights( k ) % a_axis
724 exit
725 end if
726 end do
727 exit
728 end if
729 end do
730 end if
731
732
733
734 if ( .not. associated( weight_vars(numvars + 1) % wgt4 ) ) &
735 & allocate( weight_vars(numvars + 1) % wgt4( 1 ) )
736 weight_vars(numvars + 1) % wgt4 = 1.0_dp
737
738 if ( size(dims_work) >= 4 ) then
739 do j = 1, numdims - 1
740 call historyaxisinquire( &
741 & axis = gthst_axes(j), & ! (in)
742 & name = name, & ! (out)
743 & size = dim_size ) ! (out)
744 if ( trim(dims_work(4)) == trim(name) ) then
745 deallocate( weight_vars(numvars + 1) % wgt4 )
746 allocate( weight_vars(numvars + 1) % wgt4( dim_size ) )
747 weight_vars(numvars + 1) % wgt4 = 1.0_dp
748 do k = 1, numwgts
749 call historyvarinfoinquire( &
750 & varinfo = gthst_weights(k), & ! (in)
751 & name = name ) ! (out)
752 if ( trim(dims_work(4)) // wgtsuf == trim(name) ) then
753 weight_vars(numvars + 1) % wgt4 = data_weights( k ) % a_axis
754 exit
755 end if
756 end do
757 exit
758 end if
759 end do
760 end if
761
762
763
764 if ( .not. associated( weight_vars(numvars + 1) % wgt5 ) ) &
765 & allocate( weight_vars(numvars + 1) % wgt5( 1 ) )
766 weight_vars(numvars + 1) % wgt5 = 1.0_dp
767
768 if ( size(dims_work) >= 5 ) then
769 do j = 1, numdims - 1
770 call historyaxisinquire( &
771 & axis = gthst_axes(j), & ! (in)
772 & name = name, & ! (out)
773 & size = dim_size ) ! (out)
774 if ( trim(dims_work(5)) == trim(name) ) then
775 deallocate( weight_vars(numvars + 1) % wgt5 )
776 allocate( weight_vars(numvars + 1) % wgt5( dim_size ) )
777 weight_vars(numvars + 1) % wgt5 = 1.0_dp
778 do k = 1, numwgts
779 call historyvarinfoinquire( &
780 & varinfo = gthst_weights(k), & ! (in)
781 & name = name ) ! (out)
782 if ( trim(dims_work(5)) // wgtsuf == trim(name) ) then
783 weight_vars(numvars + 1) % wgt5 = data_weights( k ) % a_axis
784 exit
785 end if
786 end do
787 exit
788 end if
789 end do
790 end if
791
792
793
794 if ( .not. associated( weight_vars(numvars + 1) % wgt6 ) ) &
795 & allocate( weight_vars(numvars + 1) % wgt6( 1 ) )
796 weight_vars(numvars + 1) % wgt6 = 1.0_dp
797
798 if ( size(dims_work) >= 6 ) then
799 do j = 1, numdims - 1
800 call historyaxisinquire( &
801 & axis = gthst_axes(j), & ! (in)
802 & name = name, & ! (out)
803 & size = dim_size ) ! (out)
804 if ( trim(dims_work(6)) == trim(name) ) then
805 deallocate( weight_vars(numvars + 1) % wgt6 )
806 allocate( weight_vars(numvars + 1) % wgt6( dim_size ) )
807 weight_vars(numvars + 1) % wgt6 = 1.0_dp
808 do k = 1, numwgts
809 call historyvarinfoinquire( &
810 & varinfo = gthst_weights(k), & ! (in)
811 & name = name ) ! (out)
812 if ( trim(dims_work(6)) // wgtsuf == trim(name) ) then
813 weight_vars(numvars + 1) % wgt6 = data_weights( k ) % a_axis
814 exit
815 end if
816 end do
817 exit
818 end if
819 end do
820 end if
821
822
823
824 if ( .not. associated( weight_vars(numvars + 1) % wgt7 ) ) &
825 & allocate( weight_vars(numvars + 1) % wgt7( 1 ) )
826 weight_vars(numvars + 1) % wgt7 = 1.0_dp
827
828 if ( size(dims_work) >= 7 ) then
829 do j = 1, numdims - 1
830 call historyaxisinquire( &
831 & axis = gthst_axes(j), & ! (in)
832 & name = name, & ! (out)
833 & size = dim_size ) ! (out)
834 if ( trim(dims_work(7)) == trim(name) ) then
835 deallocate( weight_vars(numvars + 1) % wgt7 )
836 allocate( weight_vars(numvars + 1) % wgt7( dim_size ) )
837 weight_vars(numvars + 1) % wgt7 = 1.0_dp
838 do k = 1, numwgts
839 call historyvarinfoinquire( &
840 & varinfo = gthst_weights(k), & ! (in)
841 & name = name ) ! (out)
842 if ( trim(dims_work(7)) // wgtsuf == trim(name) ) then
843 weight_vars(numvars + 1) % wgt7 = data_weights( k ) % a_axis
844 exit
845 end if
846 end do
847 exit
848 end if
849 end do
850 end if
851
852
853
854 ! 変数名の有効性を設定
855 ! Set validation of the variable name
856 !
858 & gthstnml = gthstnml, name = varname ) ! (in)
859
860 ! 変数情報の登録
861 ! Register information of variable
862 !
863 call historyvarinfocreate( &
864 & varinfo = gthst_vars(numvars + 1), & ! (out)
865 & name = varname, dims = dims_noavr, & ! (in)
866 & longname = trim(longname) // longname_avrmsg , & ! (in)
867 & units = units, xtype = precision, & ! (in)
868 & time_average = time_average_work ) ! (in) optional
869 varname_vars(numvars + 1) = varname
870 tavr_vars(numvars + 1) = time_average_work
871 deallocate( dims_noavr )
872 deallocate( dims_work )
873
874 ! 出力の有効かどうかを確認する
875 ! Confirm whether the output is effective
876 !
878
879 ! 出力のタイミングを測るための情報の取得
880 ! Get information for measurement of output timing
881 !
882 if ( output_valid_vars(numvars + 1) ) then
883
884 ! NAMELIST から読み込まれた情報の取得
885 ! Get information loaded from NAMELIST
886 !
887 call hstnmlinfoinquire( &
888 & gthstnml = gthstnml, & ! (in)
889 & name = varname, & ! (in)
890 & interval_value = interval_value, & ! (out)
891 & interval_unit = interval_unit_work, & ! (out)
892 & origin_value = origin_value, & ! (out)
893 & origin_unit = origin_unit_work, & ! (out)
894 & terminus_value = terminus_value, & ! (out)
895 & terminus_unit = terminus_unit_work, & ! (out)
896 & newfile_intvalue = newfile_intvalue, & ! (out)
897 & newfile_intunit = newfile_intunit_work ) ! (out)
898
899 ! 出力間隔ステップ数を算出する.
900 ! Calculate number of step of interval of output
901 !
903 & dccalconvertbyunit( interval_value, interval_unit_work, 'sec', cal_save )
904
905 call dccalparseunit( interval_unit_work, & ! (in)
906 & interval_unitsym_vars(numvars + 1) ) ! (out)
907
908!!$ call DCDiffTimeCreate( &
909!!$ & interval_time_vars(numvars + 1), & ! (out)
910!!$ & interval_value, interval_unit_work ) ! (in)
911
912 ! ファイルを作成するステップ数を算出する.
913 ! Calculate number of step of interval of output
914 !
916 & dccalconvertbyunit( origin_value, origin_unit_work, 'sec', cal_save )
917
918!!$ call DCDiffTimeCreate( &
919!!$ & origin_time_vars(numvars + 1), & ! (out)
920!!$ & origin_value, origin_unit_work ) ! (in)
921
922 ! ファイルをクローズするステップ数を算出する.
923 ! Calculate number of step of closure of file
924 !
926 & dccalconvertbyunit( terminus_value, terminus_unit_work, 'sec', cal_save )
927
928!!$ call DCDiffTimeCreate( &
929!!$ & terminus_time_vars(numvars + 1), & ! (out)
930!!$ & terminus_value, terminus_unit_work ) ! (in)
931
932 ! ファイルを新規に作り直すステップ数の算出
933 ! Calculate number of step of remake of file
934 !
936 & dccalconvertbyunit( real( newfile_intvalue, dp ), newfile_intunit_work, 'sec', cal_save )
937
938!!$ call DCDiffTimeCreate( &
939!!$ & newfile_inttime_vars(numvars + 1), & ! (out)
940!!$ & newfile_intvalue, newfile_intunit_work ) ! (in)
941
942 end if
943
944 ! GT_HISTORY 変数の取得
945 ! Get "GT_HISTORY" variable
946 !
947 if ( output_valid_vars(numvars + 1) ) then
948 define_mode = hstnmlinfodefinemode( gthstnml )
949 if ( define_mode ) call hstnmlinfoenddefine( gthstnml ) ! (inout)
951 & gthstnml = gthstnml, name = varname, & ! (in)
952 & history = gthst_history_vars(numvars + 1) % gthist ) ! (out)
953
954 if ( define_mode ) call hstnmlinforedefine( gthstnml ) ! (inout)
955 end if
956
957 ! 登録変数の数を更新
958 ! Update number of registered variables
959 !
960 numvars = numvars + 1
961
962999 continue
963 call storeerror(stat, subname, cause_c = cause_c, cause_i = cause_i)
964 call endsub(subname, 'stat=%d', i = (/stat/) )
965 end subroutine historyautoaddvariable1
966
967
1019 & varname, dims, longname, units, & ! (in)
1020 & xtype, time_units, time_average, & ! (in) optional
1021 & file, & ! (in) optional
1022 & origin, terminus, interval, & ! (in) optional
1023 & slice_start, slice_end, slice_stride, & ! (in) optional
1024 & space_average, & ! (in) optional
1025 & newfile_interval & ! (in) optional
1026 & )
1027
1028 ! モジュール引用 ; USE statements
1029 !
1030
1033 use dc_trace, only: beginsub, endsub, dbgmessage
1034 use dc_error, only: storeerror, dc_noerr
1035 use dc_date, only: evalbyunit
1037 use dc_types, only: dp, string
1038
1039 ! 宣言文 ; Declaration statements
1040 !
1041 implicit none
1042 character(*), intent(in):: varname
1043 ! 変数名. Variable name
1044 character(*), intent(in):: dims(:)
1045 ! 変数が依存する次元の名前.
1046 ! 時間の次元は配列の最後に指定すること.
1047 !
1048 ! Names of dependency dimensions of a variable.
1049 ! Dimension of time must be specified
1050 ! to last of an array.
1051 character(*), intent(in):: longname
1052 ! 変数の記述的名称.
1053 !
1054 ! Descriptive name of a variable
1055 character(*), intent(in):: units
1056 ! 変数の単位.
1057 !
1058 ! Units of a variable
1059 type(dc_difftime), intent(in):: origin
1060 ! 出力開始時刻.
1061 !
1062 ! Start time of output.
1063 !
1064 type(dc_difftime), intent(in):: terminus
1065 ! 出力終了時刻.
1066 !
1067 ! End time of output.
1068 !
1069 type(dc_difftime), intent(in), optional:: interval
1070 ! 出力時間間隔.
1071 !
1072 ! 省略した場合,
1073 ! 自動的に 1.0 [sec] が設定されます.
1074 !
1075 ! Interval of output time.
1076 !
1077 ! If this argument is omitted,
1078 ! a value of 1.0 [sec] is specified
1079 ! automatically.
1080 !
1081 character(*), intent(in), optional:: xtype
1082 !
1083 ! 変数のデータ型
1084 !
1085 ! デフォルトは float (単精度実数型) であ
1086 ! る. 有効なのは, double (倍精度実数型),
1087 ! int (整数型) である. 指定しない 場合や,
1088 ! 無効な型を指定した場合には, float (単
1089 ! 精度実数型) となる.
1090 !
1091 ! Data types of dimensions specified
1092 ! with "dims".
1093 !
1094 ! Default value is "float" (single precision).
1095 ! Other valid values are
1096 ! "double" (double precision),
1097 ! "int" (integer).
1098 ! If no value or invalid value is specified,
1099 ! "float" is applied.
1100 !
1101 character(*), intent(in), optional:: time_units
1102 ! 時刻次元の単位.
1103 ! Units of time dimension.
1104 logical, intent(in), optional:: time_average
1105 !
1106 ! 出力データを時間平均する場合には
1107 ! .true. を与えます. デフォルトは
1108 ! .false. です.
1109 !
1110 ! If output data is averaged, specify
1111 ! ".true.". Default is ".false.".
1112 !
1113 character(*), intent(in), optional:: file
1114 ! 出力ファイル名.
1115 ! Output file name.
1116
1117 integer, intent(in), optional:: slice_start(:)
1118 ! 空間方向の開始点.
1119 !
1120 ! 省略した場合, 座標データの開始点が設定されます.
1121 !
1122 ! Start points of spaces.
1123 !
1124 ! If this argument is omitted,
1125 ! start points of dimensions are set.
1126 !
1127 integer, intent(in), optional:: slice_end(:)
1128 ! 空間方向の終了点.
1129 !
1130 ! 省略した場合, 座標データの終了点が設定されます.
1131 !
1132 ! End points of spaces.
1133 !
1134 ! If this argument is omitted,
1135 ! End points of dimensions are set.
1136 !
1137 integer, intent(in), optional:: slice_stride(:)
1138 ! 空間方向の刻み幅.
1139 !
1140 ! 省略した場合, 1 が設定されます.
1141 !
1142 ! Strides of spaces
1143 !
1144 ! If this argument is omitted,
1145 ! 1 is set.
1146 !
1147 logical, intent(in), optional:: space_average(:)
1148 ! 平均化のフラグ.
1149 !
1150 ! .true. が指定される座標に対して平均化を
1151 ! 行います.
1152 ! 省略した場合, .false. が設定されます.
1153 !
1154 ! Flag of average.
1155 !
1156 ! Axes specified .true. are averaged.
1157 ! If this argument is omitted,
1158 ! .false. is set.
1159 !
1160 integer, intent(in), optional:: newfile_interval
1161 ! ファイル分割時間間隔.
1162 !
1163 ! 省略した場合,
1164 ! 時間方向へのファイル分割を行いません.
1165 !
1166 ! Interval of time of separation of a file.
1167 !
1168 ! If this argument is omitted,
1169 ! a files is not separated in time direction.
1170 !
1171
1172 ! 作業変数
1173 ! Work variables
1174 !
1175 real(DP):: interval_value
1176 ! データの出力間隔の数値.
1177 ! Numerical value for interval of history data output
1178 real(DP):: origin_value
1179 ! データの出力開始時刻の数値.
1180 ! Numerical value for start time of history data output
1181 real(DP):: terminus_value
1182 ! 出力終了時刻の数値.
1183 ! Numerical value for end time of output.
1184 integer:: stat
1185 character(STRING):: cause_c
1186 character(*), parameter:: subname = "HistoryAutoAddVariable2"
1187 continue
1188 call beginsub(subname, 'varname=%c', c1 = trim(varname), version = version)
1189 stat = dc_noerr
1190 cause_c = ""
1191
1192 if ( present(time_units) ) then
1193 origin_value = evalbyunit( origin, time_units )
1194 else
1195 origin_value = evalbyunit( origin, time_unit_bycreate )
1196 end if
1197
1198 if ( present(time_units) ) then
1199 terminus_value = evalbyunit( terminus, time_units )
1200 else
1201 terminus_value = evalbyunit( terminus, time_unit_bycreate )
1202 end if
1203
1204 if ( present(interval) ) then
1205 if ( present(time_units) ) then
1206 interval_value = evalbyunit( interval, time_units )
1207 else
1208 interval_value = evalbyunit( interval, time_unit_bycreate )
1209 end if
1210 else
1211 interval_value = 1.0
1212 end if
1213
1214 call dbgmessage('origin=%f, terminus=%f, interval=%f', &
1215 & d = (/ origin_value, terminus_value, interval_value /) )
1216
1218 & varname, dims, longname, units, & ! (in)
1219 & xtype, time_units, time_average, & ! (in) optional
1220 & file, & ! (in) optional
1221 & origin = origin_value, & ! (in) optional
1222 & terminus = terminus_value, & ! (in) optional
1223 & interval = interval_value, & ! (in) optional
1224 & slice_start = slice_start, & ! (in) optional
1225 & slice_end = slice_end, & ! (in) optional
1226 & slice_stride = slice_stride, & ! (in) optional
1227 & space_average = space_average, & ! (in) optional
1228 & newfile_interval = newfile_interval ) ! (in) optional
1229
1230 call storeerror(stat, subname, cause_c = cause_c)
1231 call endsub(subname, 'stat=%d', i = (/stat/) )
1232 end subroutine historyautoaddvariable2
1233
1234!--
1235! vi:set readonly sw=4 ts=8:
1236!
1237!Local Variables:
1238!mode: f90
1239!buffer-read-only: t
1240!End:
1241!
1242!++
subroutine historyautoaddvariable2(varname, dims, longname, units, xtype, time_units, time_average, file, origin, terminus, interval, slice_start, slice_end, slice_stride, space_average, newfile_interval)
subroutine historyautoaddvariable1(varname, dims, longname, units, xtype, time_units, time_average, file, origin, terminus, interval, slice_start, slice_end, slice_stride, space_average, newfile_interval)
暦と日時モジュール
日付・時刻に関する構造データ型と定数
日付および時刻に関する手続きを提供するモジュール
Definition dc_date.f90:57
エラー処理用モジュール
Definition dc_error.f90:454
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:891
integer, parameter, public dc_noerr
エラー等を保持
Definition dc_error.f90:468
integer, parameter, public dc_enotinit
-400 以下: dc ユーティリティのエラー
Definition dc_error.f90:534
integer, parameter, public hst_ealreadyregvarfix
Definition dc_error.f90:567
integer, parameter, public hst_emaxdimsdepended
Definition dc_error.f90:570
integer, parameter, public hst_evarinuse
Definition dc_error.f90:566
メッセージの出力
文字型変数の操作
Definition dc_string.f90:83
character(string) function, public joinchar(carray, expr)
デバッグ時の追跡用モジュール
Definition dc_trace.f90:150
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:680
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
種別型パラメタを提供します。
Definition dc_types.f90:55
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition dc_types.f90:128
integer, parameter, public dp
倍精度実数型変数
Definition dc_types.f90:92
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition dc_types.f90:137
type(axes_weight), dimension(1:max_vars), target, save, public weight_vars
type(gthst_nmlinfo), save, public gthstnml
type(gt_history_multi), dimension(1:max_vars), save, public gthst_history_vars
character(token), dimension(1:max_vars), save, public varname_vars
real(dp), dimension(1:max_vars), save, public newfile_inttime_vars
type(space_avr_info), dimension(1:max_vars), target, save, public space_avr_vars
type(slice_info), dimension(1:max_vars), target, save, public slice_vars
real(dp), dimension(1:max_vars), save, public interval_time_vars
character(*), parameter, public wgtsuf
integer, parameter, public max_dims_depended_by_var
character(token), save, public time_unit_bycreate
type(gt_history_varinfo), dimension(1:max_vars), save, public gthst_vars
real(dp), dimension(1:max_vars), save, public terminus_time_vars
logical, dimension(1:max_vars), save, public tavr_vars
type(gt_history_axis_data), dimension(1:nf90_max_dims), target, save, public data_weights
type(gt_history_varinfo), dimension(1:nf90_max_dims), save, public gthst_weights
real(dp), dimension(1:max_vars), save, public origin_time_vars
character(*), parameter, public version
type(gt_history_axis), dimension(1:nf90_max_dims), target, save, public gthst_axes
integer, dimension(1:max_vars), save, public interval_unitsym_vars
logical, dimension(1:max_vars), save, public output_valid_vars