gtool5 Fortran 90/95 Library 1.0.0-rc5
日本語
Loading...
Searching...
No Matches
Functions/Subroutines
historysettime.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine historysettime (time, history, difftime, timed)
 

Function/Subroutine Documentation

◆ historysettime()

subroutine historysettime ( real, intent(in), optional  time,
type(gt_history), intent(inout), optional, target  history,
type(dc_difftime), intent(in), optional  difftime,
real(dp), intent(in), optional  timed 
)

Definition at line 41 of file historysettime.f90.

42 !
45 use gtdata_generic, only: slice, put, get
46 use gtdata_types, only: gt_variable
47 use dc_date_generic, only: dcdifftimecreate, operator(<), operator(>), &
49 use dc_date_types, only: dc_difftime
51 use dc_types, only: dp
52 implicit none
53 real, intent(in), optional:: time
54 ! 時刻
55 !
56 ! ここで言う "時刻" とは、
57 ! HistoryCreate の *dims* で "0"
58 ! と指定されたものです。
59 ! もしも時刻が定義されていな
60 ! い場合は、 このサブルーチン
61 ! は何の効果も及ぼしません。
62 !
63 type(GT_HISTORY), intent(inout), optional, target:: history
64 ! 出力ファイルの設定に関する情報を
65 ! 格納した構造体
66 !
67 ! ここに指定するものは、
68 ! HistoryCreate によって初期設定
69 ! されていなければなりません。
70 !
71 type(DC_DIFFTIME), intent(in), optional:: difftime
72 ! 時刻 (dc_date_types::DC_DIFFTIME 型)
73 !
74 ! ここで言う "時刻" とは、
75 ! HistoryCreate の *dims* で "0"
76 ! と指定されたものです。
77 ! もしも時刻が定義されていな
78 ! い場合は、 このサブルーチン
79 ! は何の効果も及ぼしません。
80 !
81 real(DP), intent(in), optional:: timed
82 ! 時刻 (倍精度実数型)
83 !
84 ! ここで言う "時刻" とは、
85 ! HistoryCreate の *dims* で "0"
86 ! と指定されたものです。
87 ! もしも時刻が定義されていな
88 ! い場合は、 このサブルーチン
89 ! は何の効果も及ぼしません。
90 !
91 type(GT_HISTORY), pointer:: hst =>null()
92 type(GT_VARIABLE):: var
93 real, pointer:: buffer(:) =>null()
94 real(DP):: dt
95! type(DC_DIFFTIME):: dt
96 real(DP):: timew
97 logical:: err, dbg_mode
98 character(*), parameter:: subname = "HistorySetTime"
99 continue
100 dt = 0.0_dp
101 timew = 0.0_dp
102 call beginsub(subname)
103 if (present(history)) then
104 hst => history
105 else
106 hst => default
107 endif
108 call debug( dbg_mode )
109 if ( dbg_mode ) then
110 if ( present(difftime) ) then
111 timew = evalbyunit( difftime, '', hst % unlimited_units_symbol )
112 call dbgmessage('time=%f', d = (/timew/) )
113 elseif ( present(timed) ) then
114 call dbgmessage('time=%f', d = (/timed/) )
115 elseif ( present(time) ) then
116 call dbgmessage('time=%r', r = (/time/) )
117 end if
118 end if
119 if (hst % unlimited_index == 0) then
120 goto 999
121 endif
122 var = hst % dimvars(hst % unlimited_index)
123 hst % dim_value_written(hst % unlimited_index) = .true.
124 if ( present(difftime) ) then
125 dt = evalbyunit( difftime, '', hst % unlimited_units_symbol )
126 timew = dt
127 elseif ( present(timed) ) then
128 dt = timed
129!!$ call DCDiffTimeCreate( dt, & ! (out)
130!!$ & real( timed ), '', hst % unlimited_units_symbol ) ! (in)
131 timew = timed
132 elseif ( present(time) ) then
133 dt = time
134!!$ call DCDiffTimeCreate( dt, & ! (out)
135!!$ & time, '', hst % unlimited_units_symbol ) ! (in)
136 timew = time
137 end if
138 if ( dt < hst % oldest &
139 & .or. dt > hst % newest &
140 & .or. hst % count(2) == 0 ) then
141 hst % count(:) = maxval(hst % count(:)) + 1
142 hst % newest = max(hst % newest, dt)
143 hst % oldest = min(hst % oldest, dt)
144 call slice(var, 1, start=hst % count(1), count=1)
145 timew = dt
146! timew = EvalByUnit( dt, '', hst % unlimited_units_symbol )
147 call put(var, (/timew/), 1, err)
148 if (err) call dumperror()
149 goto 999
150 endif
151 call slice(var, 1, start=1, count=hst % count(2))
152 call get(var, buffer, err)
153 hst % count(1:1) = minloc(abs(buffer - timew))
154 deallocate(buffer)
155999 continue
156 call endsub(subname)
Interface declarations for procedures provided from dc_date.
Derived types and parameters for date and time.
Debug tracing module.
Definition dc_trace.f90:150
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:661
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
Definition dc_trace.f90:457
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:580
Provides kind type parameter values.
Definition dc_types.f90:55
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:92
type(gt_history), target, save, public default

References dc_trace::beginsub(), dc_trace::dbgmessage(), gtool_history_internal::default, dc_types::dp, and dc_trace::endsub().

Here is the call graph for this function: