11
12
13
14
15
16
17
18
19
20
21
23 use gtool_history_internal,
only:
default
24 use gtdata_generic, only: create, inquire, open, slice, close
26 use dc_present, only: present_and_false
28 use dc_date,
only: dcdifftimecreate
31 use dc_trace, only: beginsub, endsub, dbgmessage
32 implicit none
33 character(len = *), intent(in):: file
34
35
36
37 character(len = *), intent(in):: varname
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55 type(GT_HISTORY), intent(inout), optional, target:: history
56
57
58
59
60
61
62
63 logical, intent(in), optional:: overwrite
64
65
66
67
68
69
70
71 type(GT_HISTORY), pointer:: hst =>null()
72 type(GT_VARIABLE), pointer:: vwork(:) =>null(), dimvars(:) =>null()
73 type(GT_VARIABLE):: copyfrom
74 character(STRING):: fullname, url, copyurl
75 integer, pointer:: count_work(:) =>null()
76 integer, pointer:: var_avr_count_work(:) =>null()
77 integer:: var_avr_length
78 logical, pointer:: var_avr_firstput_work(:) =>null()
79 real(DP), pointer:: var_avr_coefsum_work(:) =>null()
80 real(DP), pointer:: var_avr_baseint_work(:) =>null()
81 real(DP), pointer:: var_avr_prevtime_work(:) =>null()
82
83
84 type(GT_HISTORY_AVRDATA), pointer:: var_avr_data_work(:) =>null()
85 integer:: nvars, numdims, i
86 logical:: growable, overwrite_required
87 character(*), parameter:: subname = "HistoryCopyVariable1"
88 continue
89 call beginsub(subname, 'file=%c varname=%c', &
90 & c1=trim(file), c2=trim(varname))
91
92 if (present(history)) then
93 hst => history
94 else
96 endif
97
98
99 if (associated(hst % vars)) then
100 nvars = size(hst % vars(:))
101 vwork => hst % vars
102 count_work => hst % count
103 nullify(hst % vars, hst % count)
104 allocate(hst % vars(nvars + 1), hst % count(nvars + 1))
105 hst % vars(1:nvars) = vwork(1:nvars)
106 hst % count(1:nvars) = count_work(1:nvars)
107 deallocate(vwork, count_work)
108 count_work => hst % growable_indices
109 nullify(hst % growable_indices)
110 allocate(hst % growable_indices(nvars + 1))
111 hst % growable_indices(1:nvars) = count_work(1:nvars)
112 deallocate(count_work)
113
114
115
116
117
118 var_avr_count_work => hst % var_avr_count
119 nullify( hst % var_avr_count )
120 allocate( hst % var_avr_count(nvars + 1) )
121 hst % var_avr_count(1:nvars) = var_avr_count_work(1:nvars)
122 deallocate( var_avr_count_work )
123
124 var_avr_data_work => hst % var_avr_data
125 nullify(hst % var_avr_data)
126 allocate(hst % var_avr_data(nvars + 1))
127 do i = 1, nvars
128 hst % var_avr_data(i) % length = var_avr_data_work(i) % length
129 allocate(hst % var_avr_data(i) % &
130 & a_dataavr(var_avr_data_work(i) % length))
131 hst % var_avr_data(i) % a_DataAvr = var_avr_data_work(i) % a_DataAvr
132 end do
133 deallocate( var_avr_data_work )
134
135 var_avr_firstput_work => hst % var_avr_firstput
136 nullify( hst % var_avr_firstput )
137 allocate( hst % var_avr_firstput(nvars + 1) )
138 hst % var_avr_firstput(1:nvars) = var_avr_firstput_work(1:nvars)
139 deallocate( var_avr_firstput_work )
140
141 var_avr_coefsum_work => hst % var_avr_coefsum
142 nullify( hst % var_avr_coefsum )
143 allocate( hst % var_avr_coefsum(nvars + 1) )
144 hst % var_avr_coefsum(1:nvars) = var_avr_coefsum_work(1:nvars)
145 deallocate( var_avr_coefsum_work )
146
147 var_avr_baseint_work => hst % var_avr_baseint
148 nullify( hst % var_avr_baseint )
149 allocate( hst % var_avr_baseint(nvars + 1) )
150 hst % var_avr_baseint(1:nvars) = var_avr_baseint_work(1:nvars)
151 deallocate( var_avr_baseint_work )
152
153 var_avr_prevtime_work => hst % var_avr_prevtime
154 nullify( hst % var_avr_prevtime )
155 allocate( hst % var_avr_prevtime(nvars + 1) )
156 hst % var_avr_prevtime(1:nvars) = var_avr_prevtime_work(1:nvars)
157 deallocate( var_avr_prevtime_work )
158 else
159
160
161 allocate(hst % vars(1), hst % count(2), hst % growable_indices(1))
162 hst % count(2) = 0
163 allocate(hst % var_avr_count(1), hst % var_avr_data(1))
164 allocate(hst % var_avr_firstput(1), hst % var_avr_coefsum(1))
165 allocate(hst % var_avr_baseint(1), hst % var_avr_prevtime(1))
166 endif
167 nvars = size(hst % vars(:))
168 hst % growable_indices(nvars) = 0
169 hst % count(nvars) = 0
170 hst % var_avr_count(nvars) = -1
171 hst % var_avr_firstput = .true.
172 hst % var_avr_coefsum(nvars) = 0.0_dp
173 hst % var_avr_baseint(nvars) = 0.0_dp
174
175
176
177 hst % var_avr_prevtime(nvars) = hst % var_avr_baseint(nvars)
178
179
181 call open(copyfrom, copyurl)
182
183
184 call inquire(hst % dimvars(1), url=url)
186 overwrite_required = .true.
187 if (present_and_false(overwrite)) overwrite_required = .false.
188 call create(hst % vars(nvars), trim(fullname), copyfrom, &
189 & copyvalue=.false., overwrite=overwrite_required)
190
191
192 call inquire(hst % vars(nvars), alldims=numdims)
193 allocate(dimvars(numdims))
194
195
196 do, i = 1, numdims
197 call open(var=dimvars(i), source_var=hst % vars(nvars), &
198 & dimord=i, count_compact=.true.)
199
200 call inquire(var=dimvars(i), growable=growable)
201 if (growable) then
202 hst % growable_indices(nvars) = i
203 endif
204 enddo
205
206
207 if (hst % growable_indices(nvars) /= 0) then
208 call slice(hst % vars(nvars), hst % growable_indices(nvars), &
209 & start=1, count=1, stride=1)
210 endif
211
212 deallocate(dimvars)
213
214 call inquire( hst % vars(nvars), size = var_avr_length )
215 allocate( hst % var_avr_data(nvars) % a_DataAvr(var_avr_length) )
216 hst % var_avr_data(nvars) % length = var_avr_length
217 hst % var_avr_data(nvars) % a_DataAvr = 0.0_dp
218
219 call close(copyfrom)
220 call endsub(subname)
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
integer, parameter, public dp
倍精度実数型変数
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
character, parameter, public gt_atmark
type(gt_history), target, save default
