MONC
timeaveraged_manipulation.F90
Go to the documentation of this file.
1 
15  implicit none
16 
17 #ifndef TEST_MODE
18  private
19 #endif
20 
23  character(len=STRING_LENGTH) :: field_name
24  real(kind=DEFAULT_PRECISION) :: start_time, previous_time, previous_output_time
25  integer :: mutex
26  logical :: empty_values
27  real(kind=DEFAULT_PRECISION), dimension(:), allocatable :: time_averaged_values
29 
30  type(hashmap_type), volatile :: timeaveraged_values
31  integer, volatile :: timeaveraged_value_rw_lock
32 
36 contains
37 
41  end subroutine init_time_averaged_manipulation
42 
48 
49  logical function is_time_averaged_time_manipulation_ready_to_write(latest_time, output_frequency, write_time, &
50  latest_timestep, write_timestep)
51  real, intent(in) :: latest_time, output_frequency, write_time
52  integer, intent(in) :: latest_timestep, write_timestep
53 
54  is_time_averaged_time_manipulation_ready_to_write=latest_time + output_frequency .gt. write_time
56 
64  type(data_values_type) function perform_timeaveraged_time_manipulation(instant_values, output_frequency, &
65  field_name, timestep, time)
66  real(kind=DEFAULT_PRECISION), dimension(:), intent(in) :: instant_values
67  real, intent(in) :: output_frequency
68  real(kind=DEFAULT_PRECISION), intent(in) :: time
69  character(len=*), intent(in) :: field_name
70  integer, intent(in) :: timestep
71 
72  type(time_averaged_completed_type), pointer :: timeaveraged_value
73 
74  timeaveraged_value=>find_or_add_timeaveraged_value(timestep, field_name)
75 
76  call check_thread_status(forthread_mutex_lock(timeaveraged_value%mutex))
77  call time_average(timeaveraged_value, instant_values, time)
78 
79  if ((aint(time*10000000.0)-aint(timeaveraged_value%previous_output_time*10000000.0))/10000000.0 .ge. output_frequency) then
80  timeaveraged_value%previous_output_time=time
81  allocate(perform_timeaveraged_time_manipulation%values(size(timeaveraged_value%time_averaged_values)))
82  perform_timeaveraged_time_manipulation%values=timeaveraged_value%time_averaged_values
83  timeaveraged_value%time_averaged_values=0.0_default_precision
84  timeaveraged_value%start_time=time
85  timeaveraged_value%previous_time=time
86  timeaveraged_value%empty_values=.true.
87  end if
88  call check_thread_status(forthread_mutex_unlock(timeaveraged_value%mutex))
90 
95  subroutine time_average(timeaveraged_value, instant_values, time)
96  type(time_averaged_completed_type), intent(inout) :: timeaveraged_value
97  real(kind=DEFAULT_PRECISION), dimension(:), intent(in) :: instant_values
98  real(kind=DEFAULT_PRECISION), intent(in) :: time
99 
100  integer :: i
101  real(kind=DEFAULT_PRECISION) :: timeav, timedg, combined_add
102 
103  timeav=time-timeaveraged_value%start_time
104  timedg=time-timeaveraged_value%previous_time
105  combined_add=timeav+timedg
106 
107  if (.not. allocated(timeaveraged_value%time_averaged_values)) then
108  allocate(timeaveraged_value%time_averaged_values(size(instant_values)))
109  timeaveraged_value%time_averaged_values=0.0_default_precision
110  end if
111 
112  if (timeaveraged_value%empty_values) then
113  timeaveraged_value%empty_values=.false.
114  timeaveraged_value%time_averaged_values=instant_values
115  else
116  do i=1, size(instant_values)
117  timeaveraged_value%time_averaged_values(i)=(timeav*timeaveraged_value%time_averaged_values(i)+&
118  timedg*instant_values(i)) / combined_add
119  end do
120  end if
121 
122  timeaveraged_value%previous_time=time
123  end subroutine time_average
124 
127  integer(kind=8) function prepare_to_serialise_time_averaged_state()
128  type(mapentry_type) :: map_entry
129  type(iterator_type) :: iterator
130  class(*), pointer :: generic
131 
132  call check_thread_status(forthread_rwlock_rdlock(timeaveraged_value_rw_lock))
133 
136  do while (c_has_next(iterator))
137  map_entry=c_next_mapentry(iterator)
138  generic=>c_get_generic(map_entry)
139  if (associated(generic)) then
140  select type(generic)
144  (kind(prepare_to_serialise_time_averaged_state)*2)+len(trim(map_entry%key))
145  end select
146  end if
147  end do
149 
152  subroutine serialise_time_averaged_state(byte_data)
153  character, dimension(:), allocatable, intent(inout) :: byte_data
154 
155  integer :: current_data_point, prev_pt
156  type(mapentry_type) :: map_entry
157  type(iterator_type) :: iterator
158  class(*), pointer :: generic
159 
160  current_data_point=1
161  current_data_point=pack_scalar_field(byte_data, current_data_point, c_size(timeaveraged_values))
162 
164  do while (c_has_next(iterator))
165  map_entry=c_next_mapentry(iterator)
166  generic=>c_get_generic(map_entry)
167  if (associated(generic)) then
168  select type(generic)
170  current_data_point=pack_scalar_field(byte_data, current_data_point, len(trim(map_entry%key)))
171  byte_data(current_data_point:current_data_point+len(trim(map_entry%key))-1) = transfer(trim(map_entry%key), &
172  byte_data(current_data_point:current_data_point+len(trim(map_entry%key))-1))
173  current_data_point=current_data_point+len(trim(map_entry%key))
174 
175  prev_pt=current_data_point
176  current_data_point=current_data_point+kind(current_data_point)
177  call serialise_time_averaged_completed_value(generic, byte_data, current_data_point)
178  prev_pt=pack_scalar_field(byte_data, prev_pt, (current_data_point-kind(current_data_point)) - prev_pt)
179  end select
180  end if
181  end do
182  call check_thread_status(forthread_rwlock_unlock(timeaveraged_value_rw_lock))
183  end subroutine serialise_time_averaged_state
184 
187  subroutine unserialise_time_averaged_state(byte_data)
188  character, dimension(:), intent(in) :: byte_data
189 
190  integer :: current_data_point, number_entries, i, key_size, byte_size
191  character(len=STRING_LENGTH) :: value_key
192  class(*), pointer :: generic
193 
194  current_data_point=1
195  number_entries=unpack_scalar_integer_from_bytedata(byte_data, current_data_point)
196  if (number_entries .gt. 0) then
197  do i=1, number_entries
198  key_size=unpack_scalar_integer_from_bytedata(byte_data, current_data_point)
199  value_key=transfer(byte_data(current_data_point:current_data_point+key_size-1), value_key)
200  value_key(key_size+1:)=" "
201  current_data_point=current_data_point+key_size
202  byte_size=unpack_scalar_integer_from_bytedata(byte_data, current_data_point)
203  generic=>unserialise_time_averaged_completed_value(byte_data(current_data_point:current_data_point+byte_size-1))
204  call c_put_generic(timeaveraged_values, value_key, generic, .false.)
205  current_data_point=current_data_point+byte_size
206  end do
207  end if
208  end subroutine unserialise_time_averaged_state
209 
213  integer(kind=8) function prepare_to_serialise_time_averaged_completed_value(time_av_value)
214  type(time_averaged_completed_type), intent(inout) :: time_av_value
215 
216  call check_thread_status(forthread_mutex_lock(time_av_value%mutex))
217 
218  prepare_to_serialise_time_averaged_completed_value=(kind(time_av_value%start_time) * 3) + kind(time_av_value%empty_values) + &
219  (size(time_av_value%time_averaged_values) * kind(time_av_value%time_averaged_values)) + &
220  (kind(prepare_to_serialise_time_averaged_completed_value) * 2) + len(time_av_value%field_name)
222 
227  subroutine serialise_time_averaged_completed_value(time_av_value, byte_data, current_data_point)
228  type(time_averaged_completed_type), intent(inout) :: time_av_value
229  character, dimension(:), allocatable, intent(inout) :: byte_data
230  integer, intent(inout) :: current_data_point
231 
232  integer :: i
233 
234  current_data_point=pack_scalar_field(byte_data, current_data_point, double_real_value=time_av_value%start_time)
235  current_data_point=pack_scalar_field(byte_data, current_data_point, double_real_value=time_av_value%previous_time)
236  current_data_point=pack_scalar_field(byte_data, current_data_point, double_real_value=time_av_value%previous_output_time)
237  current_data_point=pack_scalar_field(byte_data, current_data_point, logical_value=time_av_value%empty_values)
238  current_data_point=pack_scalar_field(byte_data, current_data_point, len(trim(time_av_value%field_name)))
239  byte_data(current_data_point:current_data_point+len(trim(time_av_value%field_name))-1) = transfer(&
240  trim(time_av_value%field_name), byte_data(current_data_point:current_data_point+len(trim(time_av_value%field_name))-1))
241  current_data_point=current_data_point+len(trim(time_av_value%field_name))
242  current_data_point=pack_scalar_field(byte_data, current_data_point, size(time_av_value%time_averaged_values))
243  current_data_point=pack_array_field(byte_data, current_data_point, real_array_1d=time_av_value%time_averaged_values)
244  call check_thread_status(forthread_mutex_unlock(time_av_value%mutex))
246 
250  character, dimension(:), intent(in) :: byte_data
251  type(time_averaged_completed_type), pointer :: unserialise_time_averaged_completed_value
252 
253  integer :: current_data_point, i, values_size, byte_size, str_size
254 
255  allocate(unserialise_time_averaged_completed_value)
256  current_data_point=1
257  unserialise_time_averaged_completed_value%start_time=unpack_scalar_dp_real_from_bytedata(byte_data, current_data_point)
258  unserialise_time_averaged_completed_value%previous_time=unpack_scalar_dp_real_from_bytedata(byte_data, current_data_point)
259  unserialise_time_averaged_completed_value%previous_output_time=&
260  unpack_scalar_dp_real_from_bytedata(byte_data, current_data_point)
261  unserialise_time_averaged_completed_value%empty_values=unpack_scalar_logical_from_bytedata(byte_data, current_data_point)
262  str_size=unpack_scalar_integer_from_bytedata(byte_data, current_data_point)
263  unserialise_time_averaged_completed_value%field_name=&
264  transfer(byte_data(current_data_point:current_data_point+str_size-1), &
265  unserialise_time_averaged_completed_value%field_name)
266  unserialise_time_averaged_completed_value%field_name(str_size+1:)=" "
267  current_data_point=current_data_point+str_size
268  values_size=unpack_scalar_integer_from_bytedata(byte_data, current_data_point)
269  allocate(unserialise_time_averaged_completed_value%time_averaged_values(values_size))
270  byte_size=values_size*kind(unserialise_time_averaged_completed_value%time_averaged_values)
271  unserialise_time_averaged_completed_value%time_averaged_values=transfer(byte_data(current_data_point:&
272  current_data_point+byte_size-1), unserialise_time_averaged_completed_value%time_averaged_values)
273  call check_thread_status(forthread_mutex_init(unserialise_time_averaged_completed_value%mutex, -1))
275 
280  function find_or_add_timeaveraged_value(timestep, field_name)
281  integer, intent(in) :: timestep
282  character(len=*), intent(in) :: field_name
283  type(time_averaged_completed_type), pointer :: find_or_add_timeaveraged_value
284 
285  class(*), pointer :: generic
286  type(time_averaged_completed_type), pointer :: new_entry
287 
288  find_or_add_timeaveraged_value=>find_timeaveraged_value(field_name)
289  if (.not. associated(find_or_add_timeaveraged_value)) then
290  call check_thread_status(forthread_rwlock_wrlock(timeaveraged_value_rw_lock))
291  find_or_add_timeaveraged_value=>find_timeaveraged_value(field_name, .false.)
292  if (.not. associated(find_or_add_timeaveraged_value)) then
293  allocate(new_entry)
294  new_entry%field_name=field_name
295  new_entry%start_time=0.0_default_precision
296  new_entry%previous_time=0.0_default_precision
297  new_entry%empty_values=.true.
298  new_entry%previous_output_time=0.0_default_precision
299  call check_thread_status(forthread_mutex_init(new_entry%mutex, -1))
300  generic=>new_entry
301  call c_put_generic(timeaveraged_values, field_name, generic, .false.)
302  find_or_add_timeaveraged_value=>new_entry
303  end if
304  call check_thread_status(forthread_rwlock_unlock(timeaveraged_value_rw_lock))
305  end if
306  end function find_or_add_timeaveraged_value
307 
312  function find_timeaveraged_value(field_name, issue_read_lock)
313  character(len=*), intent(in) :: field_name
314  type(time_averaged_completed_type), pointer :: find_timeaveraged_value
315  logical, intent(in), optional :: issue_read_lock
316 
317  class(*), pointer :: generic
318  logical :: do_read_lock
319 
320  if (present(issue_read_lock)) then
321  do_read_lock=issue_read_lock
322  else
323  do_read_lock=.true.
324  end if
325 
326  if (do_read_lock) call check_thread_status(forthread_rwlock_rdlock(timeaveraged_value_rw_lock))
327  generic=>c_get_generic(timeaveraged_values, field_name)
328  if (do_read_lock) call check_thread_status(forthread_rwlock_unlock(timeaveraged_value_rw_lock))
329  if (associated(generic)) then
330  select type(generic)
332  find_timeaveraged_value=>generic
333  end select
334  else
335  find_timeaveraged_value=>null()
336  end if
337  end function find_timeaveraged_value
Performs time averaged, time manipulation and only returns a value if the output frequency determines...
integer function forthread_rwlock_init(rwlock_id, attr_id)
Definition: forthread.F90:504
Gets a specific generic element out of the list, stack, queue or map with the corresponding key...
integer function forthread_mutex_unlock(mutex_id)
Definition: forthread.F90:302
logical function, public unpack_scalar_logical_from_bytedata(data, start_point)
Unpacks a scalar logical from some byte data, this is a very simple unpack routine wrapping the trans...
Definition: datautils.F90:48
type(time_averaged_completed_type) function, pointer find_timeaveraged_value(field_name, issue_read_lock)
Finds a time averaged value based upon its field name.
integer function forthread_mutex_destroy(mutex_id)
Definition: forthread.F90:265
Contains functionality for managing and extracting data from the raw data dumps that the IO server re...
Definition: datautils.F90:3
type(time_averaged_completed_type) function, pointer find_or_add_timeaveraged_value(timestep, field_name)
Retrieves or creates (and retrieves) a time averaged value based upon the information provided...
integer, parameter, public default_precision
MPI communication type which we use for the prognostic and calculation data.
Definition: datadefn.F90:17
type(hashmap_type), volatile timeaveraged_values
integer function forthread_rwlock_rdlock(lock_id)
Definition: forthread.F90:514
Contains common definitions for the data and datatypes used by MONC.
Definition: datadefn.F90:2
A hashmap structure, the same as a map but uses hashing for greatly improved performance when storing...
Definition: collections.F90:94
integer function forthread_mutex_init(mutex_id, attr_id)
Definition: forthread.F90:274
integer function forthread_rwlock_wrlock(lock_id)
Definition: forthread.F90:532
subroutine, public unserialise_time_averaged_state(byte_data)
Unserialises some byte data to initialise the state from some previous version.
This defines some constants and procedures that are useful to the IO server and clients that call it...
Definition: ioclient.F90:3
This is a thread pool and the single management "main" thread will spawn out free threads in the pool...
Definition: threadpool.F90:5
type(time_averaged_completed_type) function, pointer unserialise_time_averaged_completed_value(byte_data)
Will create a specific time averaged completed value based upon the provided serialised data...
Returns the number of elements in the collection.
real(kind=double_precision) function, public unpack_scalar_dp_real_from_bytedata(data, start_point)
Unpacks a double precision scalar real from some byte data, this is a very simple unpack routine wrap...
Definition: datautils.F90:89
subroutine, public check_thread_status(ierr)
Checks the error status of any thread operation and reports an error if it failed.
Definition: threadpool.F90:229
integer(kind=8) function prepare_to_serialise_time_averaged_completed_value(time_av_value)
Prepares to serialise a time averaged completed value, both determines the storage size and also issu...
integer function forthread_mutex_lock(mutex_id)
Definition: forthread.F90:284
Collection data structures.
Definition: collections.F90:7
subroutine, public serialise_time_averaged_state(byte_data)
Serialises the state of this manipulator so that it can be restarted later on. Releases any locks iss...
logical function, public is_time_averaged_time_manipulation_ready_to_write(latest_time, output_frequency, write_time, latest_timestep, write_timestep)
integer, parameter, public string_length
Default length of strings.
Definition: datadefn.F90:10
integer function, public unpack_scalar_integer_from_bytedata(data, start_point)
Unpacks a scalar integer from some byte data, this is a very simple unpack routine wrapping the trans...
Definition: datautils.F90:34
integer function forthread_rwlock_destroy(rwlock_id)
Definition: forthread.F90:495
subroutine, public finalise_time_averaged_manipulation()
Finalises the reduction action, waiting for all outstanding requests and then freeing data...
integer function, public pack_array_field(buffer, start_offset, int_array, real_array_1d, real_array_2d, real_array_3d, real_array_4d)
Packs an array field into the sending buffer.
Definition: ioclient.F90:273
integer function forthread_rwlock_unlock(lock_id)
Definition: forthread.F90:550
Puts a generic key-value pair into the map.
subroutine, public init_time_averaged_manipulation()
Initialises the reduction action.
integer(kind=8) function, public prepare_to_serialise_time_averaged_state()
Prepares to serialise the time averaged state values. Both determines the storage size required and a...
subroutine serialise_time_averaged_completed_value(time_av_value, byte_data, current_data_point)
Serialises a specific time averaged completed value, releases any locks issued during preparation...
Parses the XML configuration file to produce the io configuration description which contains the data...
type(data_values_type) function, public perform_timeaveraged_time_manipulation(instant_values, output_frequency, field_name, timestep, time)
Performs the time averaged manipulation and only returns values if these are to be stored (i...
subroutine time_average(timeaveraged_value, instant_values, time)
Does the time averaging itself.
integer function, public pack_scalar_field(buffer, start_offset, int_value, real_value, single_real_value, double_real_value, string_value, logical_value)
Packs the data of a scalar field into a buffer.
Definition: ioclient.F90:312