42
52 implicit none
53 real, intent(in), optional:: time
54
55
56
57
58
59
60
61
62
63 type(GT_HISTORY), intent(inout), optional, target:: history
64
65
66
67
68
69
70
71 type(DC_DIFFTIME), intent(in), optional:: difftime
72
73
74
75
76
77
78
79
80
81 real(DP), intent(in), optional:: timed
82
83
84
85
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
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
103 if (present(history)) then
104 hst => history
105 else
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 )
113 elseif ( present(timed) ) then
115 elseif ( present(time) ) then
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
130
131 timew = timed
132 elseif ( present(time) ) then
133 dt = time
134
135
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
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
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)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
integer, parameter, public dp
倍精度実数型変数
type(gt_history), target, save, public default