23 character(len=STRING_LENGTH) :: field_name
24 real(kind=DEFAULT_PRECISION) :: start_time, previous_time, previous_output_time
26 logical :: empty_values
27 real(kind=DEFAULT_PRECISION),
dimension(:),
allocatable :: time_averaged_values
50 latest_timestep, write_timestep)
51 real,
intent(in) :: latest_time, output_frequency, write_time
52 integer,
intent(in) :: latest_timestep, write_timestep
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
77 call time_average(timeaveraged_value, instant_values, time)
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.
95 subroutine time_average(timeaveraged_value, instant_values, time)
97 real(kind=DEFAULT_PRECISION),
dimension(:),
intent(in) :: instant_values
98 real(kind=DEFAULT_PRECISION),
intent(in) :: time
101 real(kind=DEFAULT_PRECISION) :: timeav, timedg, combined_add
103 timeav=time-timeaveraged_value%start_time
104 timedg=time-timeaveraged_value%previous_time
105 combined_add=timeav+timedg
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
112 if (timeaveraged_value%empty_values)
then 113 timeaveraged_value%empty_values=.false.
114 timeaveraged_value%time_averaged_values=instant_values
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
122 timeaveraged_value%previous_time=time
130 class(*),
pointer :: generic
139 if (
associated(generic))
then 153 character,
dimension(:),
allocatable,
intent(inout) :: byte_data
155 integer :: current_data_point, prev_pt
158 class(*),
pointer :: generic
167 if (
associated(generic))
then 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))
175 prev_pt=current_data_point
176 current_data_point=current_data_point+kind(current_data_point)
178 prev_pt=
pack_scalar_field(byte_data, prev_pt, (current_data_point-kind(current_data_point)) - prev_pt)
188 character,
dimension(:),
intent(in) :: byte_data
190 integer :: current_data_point, number_entries, i, key_size, byte_size
191 character(len=STRING_LENGTH) :: value_key
192 class(*),
pointer :: generic
196 if (number_entries .gt. 0)
then 197 do i=1, number_entries
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
205 current_data_point=current_data_point+byte_size
216 call check_thread_status(forthread_mutex_lock(time_av_value%mutex))
219 (
size(time_av_value%time_averaged_values) * kind(time_av_value%time_averaged_values)) + &
229 character,
dimension(:),
allocatable,
intent(inout) :: byte_data
230 integer,
intent(inout) :: current_data_point
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))
250 character,
dimension(:),
intent(in) :: byte_data
253 integer :: current_data_point, i, values_size, byte_size, str_size
255 allocate(unserialise_time_averaged_completed_value)
259 unserialise_time_averaged_completed_value%previous_output_time=&
261 unserialise_time_averaged_completed_value%empty_values=unpack_scalar_logical_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
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))
281 integer,
intent(in) :: timestep
282 character(len=*),
intent(in) :: field_name
285 class(*),
pointer :: generic
289 if (.not.
associated(find_or_add_timeaveraged_value))
then 292 if (.not.
associated(find_or_add_timeaveraged_value))
then 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))
302 find_or_add_timeaveraged_value=>new_entry
313 character(len=*),
intent(in) :: field_name
315 logical,
intent(in),
optional :: issue_read_lock
317 class(*),
pointer :: generic
318 logical :: do_read_lock
320 if (
present(issue_read_lock))
then 321 do_read_lock=issue_read_lock
329 if (
associated(generic))
then 332 find_timeaveraged_value=>generic
335 find_timeaveraged_value=>null()
Performs time averaged, time manipulation and only returns a value if the output frequency determines...
integer, volatile timeaveraged_value_rw_lock
integer function forthread_rwlock_init(rwlock_id, attr_id)
Gets a specific generic element out of the list, stack, queue or map with the corresponding key...
integer function forthread_mutex_unlock(mutex_id)
Overall IO configuration.
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...
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)
Contains functionality for managing and extracting data from the raw data dumps that the IO server re...
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.
type(hashmap_type), volatile timeaveraged_values
integer function forthread_rwlock_rdlock(lock_id)
Contains common definitions for the data and datatypes used by MONC.
A hashmap structure, the same as a map but uses hashing for greatly improved performance when storing...
integer function forthread_mutex_init(mutex_id, attr_id)
integer function forthread_rwlock_wrlock(lock_id)
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...
This is a thread pool and the single management "main" thread will spawn out free threads in the pool...
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...
subroutine, public check_thread_status(ierr)
Checks the error status of any thread operation and reports an error if it failed.
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)
Collection data structures.
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.
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...
integer function forthread_rwlock_destroy(rwlock_id)
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.
integer function forthread_rwlock_unlock(lock_id)
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...
The completed time averaged values.
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.