129 & varname, dims, longname, units, & ! (in)
130 & xtype, time_units, time_average, &
132 & origin, terminus, interval, &
133 & slice_start, slice_end, slice_stride, &
155 use gtool_history,
only: historyvarinfocreate, historyvarinfoinquire, &
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
172 character(*),
intent(in):: varname
174 character(*),
intent(in):: dims(:)
181 character(*),
intent(in):: longname
185 character(*),
intent(in):: units
189 character(*),
intent(in),
optional:: xtype
209 character(*),
intent(in),
optional:: time_units
212 logical,
intent(in),
optional:: time_average
221 character(*),
intent(in),
optional:: file
225 real(DP),
intent(in),
optional:: origin
237 real(DP),
intent(in),
optional:: terminus
249 real(DP),
intent(in),
optional:: interval
261 integer,
intent(in),
optional:: slice_start(:)
271 integer,
intent(in),
optional:: slice_end(:)
281 integer,
intent(in),
optional:: slice_stride(:)
291 logical,
intent(in),
optional:: space_average(:)
304 integer,
intent(in),
optional:: newfile_interval
319 character(TOKEN):: interval_unit_work
322 character(TOKEN):: origin_unit_work
325 character(TOKEN):: terminus_unit_work
328 character(TOKEN):: newfile_intunit_work
332 real(DP):: interval_value
335 real(DP):: origin_value
338 real(DP):: terminus_value
341 integer:: newfile_intvalue
344 character(TOKEN):: time_name
347 character(STRING),
allocatable:: dims_work(:)
350 character(TOKEN):: precision
353 logical:: time_average_work
356 logical:: space_average_work(1:numdims-1)
357 integer:: slice_start_work(1:numdims-1)
360 integer:: slice_end_work(1:numdims-1)
363 integer:: slice_stride_work(1:numdims-1)
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"
384 cause_c =
'gtool_historyauto'
393 &
'"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoAllVarFix"', &
394 & c1 = trim(varname) )
396 cause_c =
'HistoryAutoAllVarFix'
404 call historyvarinfoinquire( &
407 if ( trim(varname) == trim(name) )
then
425 call historyaxisinquire( &
429 if (
size(dims) > 0 )
then
431 if ( trim( dims(
size(dims)) ) == trim( time_name ) )
then
432 allocate( dims_work(
size(dims)) )
435 allocate( dims_work(
size(dims)) )
438 if ( trim( dims(i) ) /= trim( time_name ) )
then
439 dims_work( cnt ) = dims( i )
443 dims_work(
size(dims)) = time_name
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,
',') ) )
453 allocate( dims_work(
size(dims)+1) )
454 dims_work(1:
size(dims)) = dims
455 dims_work(
size(dims)+1) = time_name
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 ) )
463 allocate( dims_work(1) )
464 dims_work(1) = time_name
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 ) )
477 &
'number of dimensions' // &
478 &
' on which one variable depends must not be greater than %d (varname=<%c>, dims=<%c>). ', &
480 & c1 = trim( varname ), c2 = trim(
joinchar(dims_work,
',') ) )
482 cause_i =
size( dims_work )
492 & err = varname_not_found )
493 if ( varname_not_found )
then
499 & interval_unit = interval_unit_work, &
500 & origin_unit = origin_unit_work , &
501 & terminus_unit = terminus_unit_work, &
502 & newfile_intunit = newfile_intunit_work )
507 if (
present( interval ) )
then
509 if (
present(time_units) ) interval_unit_work = time_units
511 if (
present( origin ) )
then
513 if (
present(time_units) ) origin_unit_work = time_units
515 if (
present( terminus ) )
then
517 if (
present(time_units) ) terminus_unit_work = time_units
519 if (
present( newfile_interval ) )
then
521 if (
present(time_units) ) newfile_intunit_work = time_units
528 & precision = xtype, &
529 & interval_value = interval, &
530 & interval_unit = interval_unit_work, &
531 & origin_value = origin, &
532 & origin_unit = origin_unit_work, &
533 & terminus_value = terminus, &
534 & terminus_unit = terminus_unit_work, &
535 & slice_start = slice_start, &
536 & slice_end = slice_end, &
537 & slice_stride = slice_stride, &
538 & time_average = time_average, &
539 & space_average = space_average, &
540 & newfile_intvalue = newfile_interval, &
541 & newfile_intunit = newfile_intunit_work )
552 & precision = precision, &
553 & time_average = time_average_work, &
554 & space_average = space_average_work, &
555 & slice_start = slice_start_work, &
556 & slice_end = slice_end_work, &
557 & slice_stride = slice_stride_work, &
558 & err = varname_not_found )
559 if ( varname_not_found )
then
562 & precision = precision, &
563 & time_average = time_average_work, &
564 & space_average = space_average_work, &
565 & slice_start = slice_start_work, &
566 & slice_end = slice_end_work, &
567 & slice_stride = slice_stride_work )
574 do i = 1,
size( dims_work ) - 1
575 do j = 1, numdims - 1
576 call historyaxisinquire( &
579 if ( trim(dims_work(i)) == trim(name) )
then
588 dims_noavr = dims_work
593 do i = 1,
size( dims_work ) - 1
595 dims_noavr( cnt ) = dims_work( i )
598 dims_avr( cnt2 ) = dims_work( i )
602 dims_noavr( cnt ) = dims_work(
size ( dims_work ) )
604 longname_avrmsg =
' averaged in ' // trim(
joinchar( dims_avr,
',' ) ) //
'-direction'
605 deallocate( dims_avr )
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( &
628 if ( slice_end_work(j) < 1 ) slice_end_work(j) = dim_size
629 if ( trim(dims_work(i)) == trim(name) )
then
633 cycle slice_subscript_search
636 end do slice_subscript_search
648 if (
size(dims_work) >= 1 )
then
649 do j = 1, numdims - 1
650 call historyaxisinquire( &
654 if ( trim(dims_work(1)) == trim(name) )
then
659 call historyvarinfoinquire( &
662 if ( trim(dims_work(1)) //
wgtsuf == trim(name) )
then
678 if (
size(dims_work) >= 2 )
then
679 do j = 1, numdims - 1
680 call historyaxisinquire( &
684 if ( trim(dims_work(2)) == trim(name) )
then
689 call historyvarinfoinquire( &
692 if ( trim(dims_work(2)) //
wgtsuf == trim(name) )
then
708 if (
size(dims_work) >= 3 )
then
709 do j = 1, numdims - 1
710 call historyaxisinquire( &
714 if ( trim(dims_work(3)) == trim(name) )
then
719 call historyvarinfoinquire( &
722 if ( trim(dims_work(3)) //
wgtsuf == trim(name) )
then
738 if (
size(dims_work) >= 4 )
then
739 do j = 1, numdims - 1
740 call historyaxisinquire( &
744 if ( trim(dims_work(4)) == trim(name) )
then
749 call historyvarinfoinquire( &
752 if ( trim(dims_work(4)) //
wgtsuf == trim(name) )
then
768 if (
size(dims_work) >= 5 )
then
769 do j = 1, numdims - 1
770 call historyaxisinquire( &
774 if ( trim(dims_work(5)) == trim(name) )
then
779 call historyvarinfoinquire( &
782 if ( trim(dims_work(5)) //
wgtsuf == trim(name) )
then
798 if (
size(dims_work) >= 6 )
then
799 do j = 1, numdims - 1
800 call historyaxisinquire( &
804 if ( trim(dims_work(6)) == trim(name) )
then
809 call historyvarinfoinquire( &
812 if ( trim(dims_work(6)) //
wgtsuf == trim(name) )
then
828 if (
size(dims_work) >= 7 )
then
829 do j = 1, numdims - 1
830 call historyaxisinquire( &
834 if ( trim(dims_work(7)) == trim(name) )
then
839 call historyvarinfoinquire( &
842 if ( trim(dims_work(7)) //
wgtsuf == trim(name) )
then
863 call historyvarinfocreate( &
865 & name = varname, dims = dims_noavr, &
866 & longname = trim(longname) // longname_avrmsg , &
867 & units = units, xtype = precision, &
868 & time_average = time_average_work )
871 deallocate( dims_noavr )
872 deallocate( dims_work )
890 & interval_value = interval_value, &
891 & interval_unit = interval_unit_work, &
892 & origin_value = origin_value, &
893 & origin_unit = origin_unit_work, &
894 & terminus_value = terminus_value, &
895 & terminus_unit = terminus_unit_work, &
896 & newfile_intvalue = newfile_intvalue, &
897 & newfile_intunit = newfile_intunit_work )
903 & dccalconvertbyunit( interval_value, interval_unit_work,
'sec',
cal_save )
905 call dccalparseunit( interval_unit_work, &
916 & dccalconvertbyunit( origin_value, origin_unit_work,
'sec',
cal_save )
926 & dccalconvertbyunit( terminus_value, terminus_unit_work,
'sec',
cal_save )
936 & dccalconvertbyunit( real( newfile_intvalue, dp ), newfile_intunit_work,
'sec',
cal_save )
963 call storeerror(stat, subname, cause_c = cause_c, cause_i = cause_i)
964 call endsub(subname,
'stat=%d', i = (/stat/) )
1019 & varname, dims, longname, units, & ! (in)
1020 & xtype, time_units, time_average, &
1022 & origin, terminus, interval, &
1023 & slice_start, slice_end, slice_stride, &
1025 & newfile_interval &
1042 character(*),
intent(in):: varname
1044 character(*),
intent(in):: dims(:)
1051 character(*),
intent(in):: longname
1055 character(*),
intent(in):: units
1069 type(
dc_difftime),
intent(in),
optional:: interval
1081 character(*),
intent(in),
optional:: xtype
1101 character(*),
intent(in),
optional:: time_units
1104 logical,
intent(in),
optional:: time_average
1113 character(*),
intent(in),
optional:: file
1117 integer,
intent(in),
optional:: slice_start(:)
1127 integer,
intent(in),
optional:: slice_end(:)
1137 integer,
intent(in),
optional:: slice_stride(:)
1147 logical,
intent(in),
optional:: space_average(:)
1160 integer,
intent(in),
optional:: newfile_interval
1175 real(DP):: interval_value
1178 real(DP):: origin_value
1181 real(DP):: terminus_value
1185 character(STRING):: cause_c
1186 character(*),
parameter:: subname =
"HistoryAutoAddVariable2"
1192 if (
present(time_units) )
then
1193 origin_value = evalbyunit( origin, time_units )
1198 if (
present(time_units) )
then
1199 terminus_value = evalbyunit( terminus, time_units )
1204 if (
present(interval) )
then
1205 if (
present(time_units) )
then
1206 interval_value = evalbyunit( interval, time_units )
1211 interval_value = 1.0
1214 call dbgmessage(
'origin=%f, terminus=%f, interval=%f', &
1215 & d = (/ origin_value, terminus_value, interval_value /) )
1218 & varname, dims, longname, units, &
1219 & xtype, time_units, time_average, &
1221 & origin = origin_value, &
1222 & terminus = terminus_value, &
1223 & interval = interval_value, &
1224 & slice_start = slice_start, &
1225 & slice_end = slice_end, &
1226 & slice_stride = slice_stride, &
1227 & space_average = space_average, &
1228 & newfile_interval = newfile_interval )
1230 call storeerror(stat, subname, cause_c = cause_c)
1231 call endsub(subname,
'stat=%d', i = (/stat/) )
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)