tstStateSet.f90

./Core/dc/f/tests/tstStateSet.f90

1 program tststateset
2 
3 #include "ScaleSTL/FortranTestMacros.h"
4 
7 use datacontainer_m
8 
9 implicit none
10 
11 type(origen_fakefactory) :: ff
12 type(origen_stateset) :: state_set
13 type(origen_state) :: state
14 type(origen_concentrations) :: concs
15 type(origen_nuclideset) :: nuclide_set
16 integer(C_INT),allocatable :: ids(:)
17 real(C_DOUBLE),allocatable :: vals(:)
18 real :: tin,tout
19 integer :: repeat
20 integer(C_INT) :: units
21 logical :: loaded,status
22 integer(C_SIZE_T) :: i,j
23 
24 !get a state set
25 call state_set % initialize()
26 loaded = ff % StateSet_random1(state_set,333)
27 if( .not. loaded )stop 1
28 
29 !initialize loop variables
30 call state % initialize()
31 call concs % initialize()
32 call nuclide_set % initialize()
33 
34 expect_eq(44,state_set%states_size())
35 do i=1,state_set % states_size()
36 
37  !get state
38  call state_set % get_states_at(state,i)
39 
40  !get concentrations (and values)
41  call state % get_concs(concs)
42  units = concs % units()
43  call concs % get_vals(vals)
44 
45  !get nuclide set (and ids)
46  call concs % get_nuclide_set(nuclide_set)
47  call nuclide_set % get_ids(ids)
48 
49  !check sizes and that alternate accessors return same
50  !values
51  expect_eq(nuclide_set%total_nuclides(),size(ids,1))
52  expect_eq(nuclide_set%total_nuclides(),size(vals,1))
53  do j=1,size(vals,1)
54  !write(*,*)ids(j),": ",vals(j)
55  expect_eq(ids(j) ,nuclide_set%ids_at(j))
56  expect_eq(vals(j) ,concs%vals_at(j))
57  end do
58 end do
59 
60 !everything that we initialized we destroy
61 call nuclide_set % destroy()
62 call concs % destroy()
63 call state % destroy()
64 
65 
66 !do timing tests on state set
67 repeat=20
68 write(*,'(a40,a10)')'method','time(ms)'
69 
70 call cpu_time(tin)
71 call loop_time_vec(repeat,state_set)
72 call cpu_time(tout)
73 write(*,'(a40,f10.3)')"ScaleSTL_Vec",1000*(tout-tin)/(repeat)
74 
75 call cpu_time(tin)
76 call loop_time_ptr(repeat,state_set)
77 call cpu_time(tout)
78 write(*,'(a40,f10.3)')"ScaleSTL_Vec*",1000*(tout-tin)/(repeat)
79 
80 call cpu_time(tin)
81 call loop_time_vec_at(repeat,state_set)
82 call cpu_time(tout)
83 write(*,'(a40,f10.3)')"ScaleSTL_Vec_at",1000*(tout-tin)/(repeat)
84 
85 call cpu_time(tin)
86 call loop_time_native(repeat,state_set)
87 call cpu_time(tout)
88 write(*,'(a40,f10.3)')"Fortran Native Arrays",1000*(tout-tin)/(repeat)
89 
90 write(*,*)
91 write(*,*)'note: repeat=',repeat
92 
93 !destroy state set
94 call state_set % destroy()
95 
96 contains
97 
98 subroutine loop_time_vec(repeat,state_set)
99 integer,intent(in) :: repeat
100 type(origen_stateset),intent(in) :: state_set
101 type(origen_state) :: state
102 type(origen_concentrations) :: concs
103 type(origen_nuclideset) :: nuclide_set
104 type(scalestl_vec_int) :: ids
105 type(scalestl_vec_dbl) :: vals
106 integer(C_INT) :: units
107 integer(C_SIZE_T) :: i,j
108 integer :: n
109 integer(C_INT) :: isum
110 real(C_DOUBLE) :: dsum
111 
112 call ids % initialize()
113 call nuclide_set % initialize()
114 call vals % initialize()
115 call concs % initialize()
116 call state % initialize()
117 
118 do n=1,repeat
119  isum=0
120  dsum=0.d0
121  do i=1,state_set % states_size()
122  !state
123  call state_set % get_states_at(state,i)
124 
125  !state.concs
126  call state % get_concs(concs)
127 
128  !state.concs.units
129  units = concs % units()
130  call concs % get_vals_vec(vals)
131 
132  !state.concs.nuclide_set
133  call concs % get_nuclide_set(nuclide_set)
134  call nuclide_set % get_ids_vec(ids)
135 
136  do j=1,vals%size()
137  isum=isum+ids%at(j) !state.concs.nuclide_set.ids
138  dsum=dsum+vals%at(j) !state.concs.vals
139  end do
140  end do
141  !write(*,*)'isum=',isum,'dsum=',dsum
142 end do
143 
144 call ids % destroy()
145 call nuclide_set % destroy()
146 call vals % destroy()
147 call concs % destroy()
148 call state % destroy()
149 
150 end subroutine
151 
152 subroutine loop_time_ptr(repeat,state_set)
153 integer,intent(in) :: repeat
154 type(origen_stateset),intent(in) :: state_set
155 type(origen_state) :: state
156 type(origen_concentrations) :: concs
157 type(origen_nuclideset) :: nuclide_set
158 type(scalestl_vec_int) :: ids
159 type(scalestl_vec_dbl) :: vals
160 integer(C_INT) :: units
161 integer(C_SIZE_T) :: i,j
162 integer :: n
163 integer(C_INT) :: isum
164 real(C_DOUBLE) :: dsum
165 
166 do n=1,repeat
167  isum=0
168  dsum=0.d0
169  do i=1,state_set % states_size()
170  !state
171  call state_set % getptr_states_at(state,i)
172 
173  !state.concs
174  call state % getptr_concs(concs)
175 
176  !state.concs.units
177  units = concs % units()
178  call concs % getptr_vals_vec(vals)
179 
180  !state.concs.nuclide_set
181  call concs % getptr_nuclide_set(nuclide_set)
182  call nuclide_set % getptr_ids_vec(ids)
183 
184  do j=1,vals%size()
185  isum=isum+ids%at(j) !state.concs.nuclide_set.ids
186  dsum=dsum+vals%at(j) !state.concs.vals
187  end do
188  end do
189  !write(*,*)'isum=',isum,'dsum=',dsum
190 end do
191 
192 end subroutine
193 
194 subroutine loop_time_vec_at(repeat,state_set)
195 integer,intent(in) :: repeat
196 type(origen_stateset),intent(in) :: state_set
197 type(origen_state) :: state
198 type(origen_concentrations) :: concs
199 type(origen_nuclideset) :: nuclide_set
200 integer(C_INT) :: units
201 integer(C_SIZE_T) :: i,j
202 integer :: n
203 integer(C_INT) :: isum
204 real(C_DOUBLE) :: dsum
205 
206 call nuclide_set % initialize()
207 call concs % initialize()
208 call state % initialize()
209 
210 do n=1,repeat
211  isum=0
212  dsum=0.d0
213  do i=1,state_set % states_size()
214  !state
215  call state_set % get_states_at(state,i)
216 
217  !state.concs
218  call state % get_concs(concs)
219 
220  !state.concs.units
221  units = concs % units()
222 
223  !state.concs.nuclide_set
224  call concs % get_nuclide_set(nuclide_set)
225 
226  do j=1,nuclide_set%total_nuclides()
227  isum=isum+nuclide_set%ids_at(j) !state.concs.nuclide_set.ids
228  dsum=dsum+concs%vals_at(j) !state.concs.vals
229  end do
230  end do
231  !write(*,*)'isum=',isum,'dsum=',dsum
232 end do
233 
234 call nuclide_set % destroy()
235 call concs % destroy()
236 call state % destroy()
237 
238 end subroutine
239 
240 
241 subroutine loop_time_native(repeat,state_set)
242 integer,intent(in) :: repeat
243 type(origen_stateset),intent(in) :: state_set
244 type(origen_state) :: state
245 type(origen_concentrations) :: concs
246 type(origen_nuclideset) :: nuclide_set
247 integer(C_INT),allocatable :: ids(:)
248 real(C_DOUBLE),allocatable :: vals(:)
249 integer(C_INT) :: units
250 integer(C_SIZE_T) :: i,j
251 integer :: n
252 integer(C_INT) :: isum
253 real(C_DOUBLE) :: dsum
254 
255 call nuclide_set % initialize()
256 call concs % initialize()
257 call state % initialize()
258 
259 do n=1,repeat
260  isum=0
261  dsum=0.d0
262  do i=1,state_set % states_size()
263  !state
264  call state_set % get_states_at(state,i)
265 
266  !state.concs
267  call state % get_concs(concs)
268 
269  !state.concs.units
270  units = concs % units()
271  call concs % get_vals(vals)
272 
273  !state.concs.nuclide_set
274  call concs % get_nuclide_set(nuclide_set)
275  call nuclide_set % get_ids(ids)
276 
277  do j=1,size(vals,1)
278  isum=isum+ids(j) !state.concs.nuclide_set.ids
279  dsum=dsum+vals(j) !state.concs.vals
280  end do
281  end do
282  !write(*,*)'isum=',isum,'dsum=',dsum
283 end do
284 
285 call nuclide_set % destroy()
286 call concs % destroy()
287 call state % destroy()
288 
289 end subroutine
290 
291 
292 end program