28 & varname, dims, longname, units, & ! (in)
29 & xtype, time_units, time_average, &
31 & origin, terminus, interval, &
32 & slice_start, slice_end, slice_stride, &
99 use gtool_history, only: historyvarinfocreate, historyvarinfoinquire, &
107 use dc_calendar, only: dccalconvertbyunit, dccalparseunit
108 use dc_date, only: dcdifftimecreate,
operator(/), mod, evalsec, &
109 &
operator(-), evalbyunit
111 use netcdf
, only: nf90_emaxvars, nf90_max_dims
117 character(*),
intent(in):: varname
119 character(*),
intent(in):: dims(:)
126 character(*),
intent(in):: longname
130 character(*),
intent(in):: units
134 character(*),
intent(in),
optional:: xtype
154 character(*),
intent(in),
optional:: time_units
157 logical,
intent(in),
optional:: time_average
166 character(*),
intent(in),
optional:: file
170 real(DP),
intent(in),
optional:: origin
182 real(DP),
intent(in),
optional:: terminus
194 real(DP),
intent(in),
optional:: interval
206 integer,
intent(in),
optional:: slice_start(:)
216 integer,
intent(in),
optional:: slice_end(:)
226 integer,
intent(in),
optional:: slice_stride(:)
236 logical,
intent(in),
optional:: space_average(:)
249 integer,
intent(in),
optional:: newfile_interval
264 character(TOKEN):: interval_unit_work
267 character(TOKEN):: origin_unit_work
270 character(TOKEN):: terminus_unit_work
273 character(TOKEN):: newfile_intunit_work
277 real(DP):: interval_value
280 real(DP):: origin_value
283 real(DP):: terminus_value
286 integer:: newfile_intvalue
289 character(TOKEN):: time_name
292 character(STRING),
allocatable:: dims_work(:)
295 character(TOKEN):: precision
298 logical:: time_average_work
301 logical:: space_average_work(1:
numdims-1)
302 integer:: slice_start_work(1:
numdims-1)
305 integer:: slice_end_work(1:
numdims-1)
308 integer:: slice_stride_work(1:
numdims-1)
312 logical:: define_mode, varname_not_found
313 integer:: cause_i, stat, i, j, k, cnt, cnt2, dim_size
314 character(TOKEN),
pointer:: dims_noavr(:) =>null(), dims_avr(:) =>null()
315 character(STRING):: longname_avrmsg
316 character(STRING):: name, cause_c
317 character(*),
parameter:: subname =
"HistoryAutoAddVariable1" 329 cause_c =
'gtool_historyauto' 338 &
'"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoAllVarFix"', &
339 & c1 = trim(varname) )
341 cause_c =
'HistoryAutoAllVarFix' 349 call historyvarinfoinquire( &
352 if ( trim(varname) == trim(name) )
then 370 call historyaxisinquire( &
374 if (
size(dims) > 0 )
then 376 if ( trim( dims(
size(dims)) ) == trim( time_name ) )
then 377 allocate( dims_work(
size(dims)) )
380 allocate( dims_work(
size(dims)) )
383 if ( trim( dims(i) ) /= trim( time_name ) )
then 384 dims_work( cnt ) = dims( i )
388 dims_work(
size(dims)) = time_name
391 &
'last entity of "dims=<%c>" must be time dimension (varname=<%c>). ' // &
392 &
' "dims" are resequenced forcibly => <%c>', &
393 & c1 = trim(
joinchar(dims,
',') ), c2 = trim( varname ), &
394 & c3 = trim(
joinchar(dims_work,
',') ) )
398 allocate( dims_work(
size(dims)+1) )
399 dims_work(1:
size(dims)) = dims
400 dims_work(
size(dims)+1) = time_name
402 &
'time dimension is not found in "dims=<%c>" (varname=<%c>). ' // &
403 &
' time dimension "%c" is appended to "dims" forcibly.', &
404 & c1 = trim(
joinchar(dims,
',') ), c2 = trim( varname ), &
405 & c3 = trim( time_name ) )
408 allocate( dims_work(1) )
409 dims_work(1) = time_name
411 &
'time dimension is not found (varname=<%c>). ' // &
412 &
' time dimension "%c" is appended to "dims" forcibly.', &
413 & c1 = trim( varname ), &
414 & c2 = trim( time_name ) )
422 &
'number of dimensions' // &
423 &
' on which one variable depends must not be greater than %d (varname=<%c>, dims=<%c>). ', &
425 & c1 = trim( varname ), c2 = trim(
joinchar(dims_work,
',') ) )
427 cause_i =
size( dims_work )
437 & err = varname_not_found )
438 if ( varname_not_found )
then 444 & interval_unit = interval_unit_work, &
445 & origin_unit = origin_unit_work , &
446 & terminus_unit = terminus_unit_work, &
447 & newfile_intunit = newfile_intunit_work )
452 if (
present( interval ) )
then 454 if (
present(time_units) ) interval_unit_work = time_units
456 if (
present( origin ) )
then 458 if (
present(time_units) ) origin_unit_work = time_units
460 if (
present( terminus ) )
then 462 if (
present(time_units) ) terminus_unit_work = time_units
464 if (
present( newfile_interval ) )
then 466 if (
present(time_units) ) newfile_intunit_work = time_units
473 & precision = xtype, &
474 & interval_value = interval, &
475 & interval_unit = interval_unit_work, &
476 & origin_value = origin, &
477 & origin_unit = origin_unit_work, &
478 & terminus_value = terminus, &
479 & terminus_unit = terminus_unit_work, &
480 & slice_start = slice_start, &
481 & slice_end = slice_end, &
482 & slice_stride = slice_stride, &
483 & time_average = time_average, &
484 & space_average = space_average, &
485 & newfile_intvalue = newfile_interval, &
486 & newfile_intunit = newfile_intunit_work )
497 & precision = precision, &
498 & time_average = time_average_work, &
499 & space_average = space_average_work, &
500 & slice_start = slice_start_work, &
501 & slice_end = slice_end_work, &
502 & slice_stride = slice_stride_work, &
503 & err = varname_not_found )
504 if ( varname_not_found )
then 507 & precision = precision, &
508 & time_average = time_average_work, &
509 & space_average = space_average_work, &
510 & slice_start = slice_start_work, &
511 & slice_end = slice_end_work, &
512 & slice_stride = slice_stride_work )
519 do i = 1,
size( dims_work ) - 1
521 call historyaxisinquire( &
524 if ( trim(dims_work(i)) == trim(name) )
then 533 dims_noavr = dims_work
538 do i = 1,
size( dims_work ) - 1
540 dims_noavr( cnt ) = dims_work( i )
543 dims_avr( cnt2 ) = dims_work( i )
547 dims_noavr( cnt ) = dims_work(
size ( dims_work ) )
549 longname_avrmsg =
' averaged in ' // trim(
joinchar( dims_avr,
',' ) ) //
'-direction' 550 deallocate( dims_avr )
566 if (
size(dims_work) > 1 )
then 567 slice_subscript_search:
do i = 1,
size( dims_work ) - 1
569 call historyaxisinquire( &
573 if ( slice_end_work(j) < 1 ) slice_end_work(j) = dim_size
574 if ( trim(dims_work(i)) == trim(name) )
then 578 cycle slice_subscript_search
581 end do slice_subscript_search
593 if (
size(dims_work) >= 1 )
then 595 call historyaxisinquire( &
599 if ( trim(dims_work(1)) == trim(name) )
then 604 call historyvarinfoinquire( &
607 if ( trim(dims_work(1)) //
wgtsuf == trim(name) )
then 623 if (
size(dims_work) >= 2 )
then 625 call historyaxisinquire( &
629 if ( trim(dims_work(2)) == trim(name) )
then 634 call historyvarinfoinquire( &
637 if ( trim(dims_work(2)) //
wgtsuf == trim(name) )
then 653 if (
size(dims_work) >= 3 )
then 655 call historyaxisinquire( &
659 if ( trim(dims_work(3)) == trim(name) )
then 664 call historyvarinfoinquire( &
667 if ( trim(dims_work(3)) //
wgtsuf == trim(name) )
then 683 if (
size(dims_work) >= 4 )
then 685 call historyaxisinquire( &
689 if ( trim(dims_work(4)) == trim(name) )
then 694 call historyvarinfoinquire( &
697 if ( trim(dims_work(4)) //
wgtsuf == trim(name) )
then 713 if (
size(dims_work) >= 5 )
then 715 call historyaxisinquire( &
719 if ( trim(dims_work(5)) == trim(name) )
then 724 call historyvarinfoinquire( &
727 if ( trim(dims_work(5)) //
wgtsuf == trim(name) )
then 743 if (
size(dims_work) >= 6 )
then 745 call historyaxisinquire( &
749 if ( trim(dims_work(6)) == trim(name) )
then 754 call historyvarinfoinquire( &
757 if ( trim(dims_work(6)) //
wgtsuf == trim(name) )
then 773 if (
size(dims_work) >= 7 )
then 775 call historyaxisinquire( &
779 if ( trim(dims_work(7)) == trim(name) )
then 784 call historyvarinfoinquire( &
787 if ( trim(dims_work(7)) //
wgtsuf == trim(name) )
then 808 call historyvarinfocreate( &
810 & name = varname, dims = dims_noavr, &
811 & longname = trim(longname) // longname_avrmsg , &
812 & units = units, xtype = precision, &
813 & time_average = time_average_work )
816 deallocate( dims_noavr )
817 deallocate( dims_work )
835 & interval_value = interval_value, &
836 & interval_unit = interval_unit_work, &
837 & origin_value = origin_value, &
838 & origin_unit = origin_unit_work, &
839 & terminus_value = terminus_value, &
840 & terminus_unit = terminus_unit_work, &
841 & newfile_intvalue = newfile_intvalue, &
842 & newfile_intunit = newfile_intunit_work )
848 & dccalconvertbyunit( interval_value, interval_unit_work,
'sec',
cal_save )
850 call dccalparseunit( interval_unit_work, &
861 & dccalconvertbyunit( origin_value, origin_unit_work,
'sec',
cal_save )
871 & dccalconvertbyunit( terminus_value, terminus_unit_work,
'sec',
cal_save )
881 & dccalconvertbyunit(
real( newfile_intvalue, DP ), newfile_intunit_work,
'sec', cal_save )
908 call storeerror(stat, subname, cause_c = cause_c, cause_i = cause_i)
909 call endsub(subname,
'stat=%d', i = (/stat/) )
914 & varname, dims, longname, units, & ! (in)
915 & xtype, time_units, time_average, &
917 & origin, terminus, interval, &
918 & slice_start, slice_end, slice_stride, &
947 character(*),
intent(in):: varname
949 character(*),
intent(in):: dims(:)
956 character(*),
intent(in):: longname
960 character(*),
intent(in):: units
986 character(*),
intent(in),
optional:: xtype
1006 character(*),
intent(in),
optional:: time_units
1009 logical,
intent(in),
optional:: time_average
1018 character(*),
intent(in),
optional:: file
1022 integer,
intent(in),
optional:: slice_start(:)
1032 integer,
intent(in),
optional:: slice_end(:)
1042 integer,
intent(in),
optional:: slice_stride(:)
1052 logical,
intent(in),
optional:: space_average(:)
1065 integer,
intent(in),
optional:: newfile_interval
1080 real(DP):: interval_value
1083 real(DP):: origin_value
1086 real(DP):: terminus_value
1090 character(STRING):: cause_c
1091 character(*),
parameter:: subname =
"HistoryAutoAddVariable2" 1097 if (
present(time_units) )
then 1098 origin_value = evalbyunit( origin, time_units )
1103 if (
present(time_units) )
then 1104 terminus_value = evalbyunit( terminus, time_units )
1109 if (
present(interval) )
then 1110 if (
present(time_units) )
then 1111 interval_value = evalbyunit( interval, time_units )
1116 interval_value = 1.0
1119 call dbgmessage(
'origin=%f, terminus=%f, interval=%f', &
1120 & d = (/ origin_value, terminus_value, interval_value /) )
1123 & varname, dims, longname, units, &
1124 & xtype, time_units, time_average, &
1126 & origin = origin_value, &
1127 & terminus = terminus_value, &
1128 & interval = interval_value, &
1129 & slice_start = slice_start, &
1130 & slice_end = slice_end, &
1131 & slice_stride = slice_stride, &
1132 & space_average = space_average, &
1133 & newfile_interval = newfile_interval )
1136 call storeerror(stat, subname, cause_c = cause_c)
1137 call endsub(subname,
'stat=%d', i = (/stat/) )
logical, save, public all_output_save
type(slice_info), dimension(1:max_vars), target, save, public slice_vars
logical, save, public initialized
integer, parameter, public dc_enotinit
real(dp), dimension(1:max_vars), save, public newfile_inttime_vars
integer, parameter, public hst_eindivisible
integer, save, public numvars
real(dp), dimension(1:max_vars), save, public interval_time_vars
logical, save, public flag_allvarfixed
integer, parameter, public max_dims_depended_by_var
type(space_avr_info), dimension(1:max_vars), target, save, public space_avr_vars
character(*), parameter, public wgtsuf
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
real(dp), dimension(1:max_vars), save, public terminus_time_vars
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)
type(gt_history_axis_data), dimension(1:nf90_max_dims), target, save, public data_weights
integer, parameter, public hst_emaxdimsdepended
integer, parameter, public hst_ealreadyregvarfix
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)
integer, parameter, public hst_evarinuse
type(gt_history_varinfo), dimension(1:max_vars), save, public gthst_vars
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
type(gt_history_varinfo), dimension(1:nf90_max_dims), save, public gthst_weights
character(string) function, public joinchar(carray, expr)
real(dp), dimension(1:max_vars), save, public origin_time_vars
type(gt_history_axis), dimension(1:nf90_max_dims), target, save, public gthst_axes
integer, parameter, public dp
倍精度実数型変数
subroutine, public dbgmessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, version)
integer, dimension(1:max_vars), save, public interval_unitsym_vars
character(token), dimension(1:max_vars), save, public varname_vars
character(token), save, public time_unit_bycreate
integer, save, public numdims
integer, parameter, public max_vars
integer, save, public numwgts
type(gthst_nmlinfo), save, public gthstnml
subroutine, public endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
logical, dimension(1:max_vars), save, public tavr_vars
type(dc_cal), save, public cal_save
type(axes_weight), dimension(1:max_vars), target, save, public weight_vars
logical, dimension(1:max_vars), save, public output_valid_vars
type(gt_history_multi), dimension(1:max_vars), save, public gthst_history_vars
character(*), parameter, public version
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ