time_storage.F90 coverage: 83.33 %func 48.17 %block
1) module Time_Storage_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10)
11) type, public :: time_storage_type
12) PetscReal, pointer :: times(:)
13) PetscReal :: cur_time
14) PetscReal :: cur_time_fraction
15) PetscInt :: cur_time_index
16) PetscInt :: max_time_index
17) PetscBool :: is_cyclic
18) PetscReal :: time_shift ! shift for cyclic data sets
19) PetscBool :: cur_time_index_changed
20) PetscBool :: cur_time_fraction_changed
21) PetscInt :: time_interpolation_method
22) PetscBool :: force_update
23) end type time_storage_type
24)
25) public :: TimeStorageCreate, &
26) TimeStorageGetTimes, &
27) TimeStorageVerify, &
28) TimeStorageUpdate, &
29) TimeStoragePrint, &
30) TimeStorageDestroy
31)
32) contains
33)
34) ! ************************************************************************** !
35)
36) function TimeStorageCreate()
37) !
38) ! Initializes a time storage
39) !
40) ! Author: Glenn Hammond
41) ! Date: 10/26/11, 05/03/13
42) !
43)
44) implicit none
45)
46) type(time_storage_type), pointer :: time_storage
47) type(time_storage_type), pointer :: TimeStorageCreate
48)
49) allocate(time_storage)
50) nullify(time_storage%times)
51) time_storage%cur_time = 0.d0
52) time_storage%cur_time_fraction = 0.d0
53) time_storage%cur_time_index = 0
54) time_storage%max_time_index = 0
55) time_storage%is_cyclic = PETSC_FALSE
56) time_storage%time_shift = 0.d0
57) time_storage%cur_time_index_changed = PETSC_FALSE
58) time_storage%cur_time_fraction_changed = PETSC_FALSE
59) time_storage%time_interpolation_method = INTERPOLATION_NULL
60) time_storage%force_update = PETSC_FALSE
61)
62) TimeStorageCreate => time_storage
63)
64) end function TimeStorageCreate
65)
66) ! ************************************************************************** !
67)
68) subroutine TimeStorageVerify(default_time, time_storage, &
69) default_time_storage, option)
70) !
71) ! Verifies the data in a time storage
72) !
73) ! Author: Glenn Hammond
74) ! Date: 10/26/11, 05/03/13
75) !
76)
77) use Option_module
78)
79) implicit none
80)
81) PetscReal :: default_time
82) type(time_storage_type), pointer :: time_storage
83) type(time_storage_type), pointer :: default_time_storage
84) type(option_type) :: option
85)
86) PetscInt :: array_size
87)
88) if (.not.associated(time_storage)) return
89)
90) if (associated(default_time_storage)) then
91) if (default_time_storage%is_cyclic) time_storage%is_cyclic = PETSC_TRUE
92) if (time_storage%time_interpolation_method == INTERPOLATION_NULL) then
93) time_storage%time_interpolation_method = &
94) default_time_storage%time_interpolation_method
95) endif
96) endif
97)
98) if (time_storage%time_interpolation_method == INTERPOLATION_NULL) then
99) option%io_buffer = 'Time interpolation method must be specified.'
100) call printErrMsg(option)
101) endif
102)
103) time_storage%max_time_index = 1
104) if (.not.associated(time_storage%times)) then
105) if (associated(default_time_storage)) then
106) if (.not.associated(default_time_storage%times)) then
107) array_size = 1
108) allocate(time_storage%times(array_size))
109) time_storage%times = default_time
110) else
111) array_size = size(default_time_storage%times,1)
112) allocate(time_storage%times(array_size))
113) time_storage%times(1:array_size) = &
114) default_time_storage%times(1:array_size)
115) endif
116) else
117) array_size = 1
118) allocate(time_storage%times(array_size))
119) time_storage%times = default_time
120) endif
121) endif
122) time_storage%max_time_index = size(time_storage%times,1)
123) time_storage%cur_time_index = 1
124)
125) time_storage%time_shift = time_storage%times(time_storage%max_time_index)
126)
127) end subroutine TimeStorageVerify
128)
129) ! ************************************************************************** !
130)
131) subroutine TimeStorageGetTimes(time_storage, option, max_sim_time, time_array)
132) !
133) ! Fills an array of times based on time storage
134) !
135) ! Author: Glenn Hammond
136) ! Date: 10/26/11, 05/03/13
137) !
138)
139) use Option_module
140)
141) implicit none
142)
143) type(time_storage_type), pointer :: time_storage
144) type(option_type) :: option
145) PetscReal :: max_sim_time
146) PetscReal, pointer :: time_array(:)
147)
148) PetscInt :: num_times
149) PetscInt :: itime
150) PetscReal :: time_shift
151) PetscReal, allocatable :: temp_times(:)
152)
153) if (.not.associated(time_storage)) then
154) nullify(time_array)
155) return
156) endif
157)
158) if (.not.time_storage%is_cyclic .or. time_storage%max_time_index == 1) then
159) allocate(time_array(time_storage%max_time_index))
160) time_array = time_storage%times
161) else ! cyclic
162) num_times = (int(max_sim_time / &
163) time_storage%times(time_storage%max_time_index))+1)* &
164) time_storage%max_time_index
165) allocate(temp_times(num_times))
166) temp_times = 0.d0
167)
168) num_times = 0
169) itime = 0
170) time_shift = 0.d0
171) do
172) num_times = num_times + 1
173) itime = itime + 1
174) ! exit for non-cyclic - but is will never enter conditional given
175) ! conditional above.
176) if (itime > time_storage%max_time_index) exit
177) temp_times(num_times) = time_storage%times(itime) + time_shift
178) if (mod(itime,time_storage%max_time_index) == 0) then
179) itime = 0
180) time_shift = time_shift + time_storage%times(time_storage%max_time_index)
181) endif
182) ! exit for cyclic
183) if (temp_times(num_times) >= max_sim_time) exit
184) enddo
185)
186) allocate(time_array(num_times))
187) time_array(:) = temp_times(1:num_times)
188) deallocate(temp_times)
189) endif
190)
191) end subroutine TimeStorageGetTimes
192)
193) ! ************************************************************************** !
194)
195) subroutine TimeStoragePrint(time_storage,option)
196) !
197) ! Prints time storage info
198) !
199) ! Author: Glenn Hammond
200) ! Date: 10/26/11, 05/03/13
201) !
202)
203) use Option_module
204)
205) implicit none
206)
207) type(time_storage_type) :: time_storage
208) type(option_type) :: option
209)
210) character(len=MAXSTRINGLENGTH) :: string
211)
212) write(option%fid_out,'(8x,''Time Storage'')')
213) if (time_storage%is_cyclic) then
214) string = 'yes'
215) else
216) string = 'no'
217) endif
218) write(option%fid_out,'(8x,''Is cyclic: '',a)') trim(string)
219) if (size(time_storage%times) > 1) then
220) write(option%fid_out,'(8x,'' Number of values: '', i7)') &
221) time_storage%max_time_index
222) write(option%fid_out,'(8x,''Start value:'',es16.8)') &
223) time_storage%times(1)
224) write(option%fid_out,'(8x,''End value:'',es16.8)') &
225) time_storage%times(time_storage%max_time_index)
226) else
227) write(option%fid_out,'(8x,''Value:'',es16.8)') time_storage%times(1)
228) endif
229)
230)
231) end subroutine TimeStoragePrint
232)
233) ! ************************************************************************** !
234)
235) subroutine TimeStorageUpdate(time_storage)
236) !
237) ! Updates a time storage
238) !
239) ! Author: Glenn Hammond
240) ! Date: 10/26/11, 05/03/13
241) !
242)
243) use Option_module
244)
245) implicit none
246)
247) type(time_storage_type) :: time_storage
248)
249) PetscInt :: irank
250) PetscInt :: cur_time_index
251) PetscInt :: next_time_index
252)
253) ! cycle times if at max_time_index and cyclic
254) if (time_storage%cur_time_index == time_storage%max_time_index .and. &
255) time_storage%is_cyclic .and. time_storage%max_time_index > 1) then
256) do cur_time_index = 1, time_storage%max_time_index
257) time_storage%times(cur_time_index) = &
258) time_storage%times(cur_time_index) + time_storage%time_shift
259) enddo
260) time_storage%cur_time_index = 1
261) endif
262)
263) cur_time_index = time_storage%cur_time_index
264) next_time_index = min(time_storage%cur_time_index+1, &
265) time_storage%max_time_index)
266)
267) ! initialize to no change
268) time_storage%cur_time_index_changed = PETSC_FALSE
269) ! find appropriate time interval
270) do
271) if (time_storage%cur_time < time_storage%times(next_time_index) .or. &
272) cur_time_index == next_time_index) &
273) exit
274)
275) if (cur_time_index /= next_time_index) &
276) ! toggle flag indicating a change in index
277) time_storage%cur_time_index_changed = PETSC_TRUE
278) cur_time_index = next_time_index
279) ! ensure that time index does not go beyond end of array
280) if (next_time_index < time_storage%max_time_index) then
281) next_time_index = next_time_index + 1
282) ! this conditional enable the code to find the correct
283) ! time index for a cyclic dataset
284) else if (time_storage%is_cyclic .and. time_storage%max_time_index > 1) then
285) do cur_time_index = 1, time_storage%max_time_index
286) time_storage%times(cur_time_index) = &
287) time_storage%times(cur_time_index) + time_storage%time_shift
288) enddo
289) cur_time_index = 1
290) next_time_index = 2
291) endif
292) enddo
293)
294) time_storage%cur_time_index = cur_time_index
295) if (cur_time_index < 1) then
296) return
297) else if (cur_time_index < time_storage%max_time_index) then
298) time_storage%cur_time_fraction_changed = PETSC_TRUE
299) ! fraction = (t-t1)/(t2-t1)
300) time_storage%cur_time_fraction = (time_storage%cur_time- &
301) time_storage%times(cur_time_index)) / &
302) (time_storage%times(next_time_index) - &
303) time_storage%times(cur_time_index))
304) else
305) if (dabs(time_storage%cur_time_fraction - 1.d0) < 1.d-10) then
306) ! essentially zero change
307) time_storage%cur_time_fraction_changed = PETSC_FALSE
308) else
309) time_storage%cur_time_fraction_changed = PETSC_TRUE
310) time_storage%cur_time_fraction = 1.d0
311) endif
312) endif
313)
314) if (time_storage%force_update) then
315) time_storage%cur_time_fraction_changed = PETSC_TRUE
316) time_storage%cur_time_index_changed = PETSC_TRUE
317) time_storage%force_update = PETSC_FALSE
318) endif
319)
320) end subroutine TimeStorageUpdate
321)
322) ! ************************************************************************** !
323)
324) subroutine TimeStorageDestroy(time_storage)
325) !
326) ! Destroys a time storage associated with a sub_condition
327) !
328) ! Author: Glenn Hammond
329) ! Date: 10/26/11, 05/03/13
330) !
331)
332) implicit none
333)
334) type(time_storage_type), pointer :: time_storage
335)
336) if (.not.associated(time_storage)) return
337)
338) if (associated(time_storage%times)) deallocate(time_storage%times)
339) nullify(time_storage%times)
340)
341) deallocate(time_storage)
342) nullify(time_storage)
343)
344) end subroutine TimeStorageDestroy
345)
346) end module Time_Storage_module