inter-io-specifics.F90

Go to the documentation of this file.

module inter_io_specifics_mod
  use datadefn_mod, only : default_precision, string_length
  use configuration_parser_mod, only : data_size_stride, handle_recv_data_from_io_server, io_configuration_type, &
       io_configuration_data_definition_type, io_configuration_inter_communication_description, extend_inter_io_comm_array       
  use io_server_client_mod, only : data_sizing_description_type, pack_scalar_field, pack_array_field
  use forthread_mod, only : forthread_rwlock_rdlock, forthread_rwlock_wrlock, forthread_rwlock_unlock, &
       forthread_rwlock_init, forthread_rwlock_destroy, forthread_mutex_init
  use threadpool_mod, only : check_thread_status
  implicit none

#ifndef TEST_MODE
  private
#endif

  abstract interface
     subroutine handle_completion(io_configuration, values, field_name, timestep)
       import default_precision, string_length, io_configuration_type
       type(io_configuration_type), intent(inout) :: io_configuration
       real(DEFAULT_PRECISION), dimension(:) :: values
       character(len=STRING_LENGTH) :: field_name
       integer :: timestep
     end subroutine handle_completion
  end interface

  integer :: starting_tag=20

  public handle_completion, register_inter_io_communication, package_inter_io_communication_message, &
       unpackage_inter_io_communication_message, find_inter_io_from_name
contains  

  subroutine register_inter_io_communication(io_configuration, message_tag, handling_procedure, name)
    type(io_configuration_type), intent(inout) :: io_configuration
    integer, intent(in) :: message_tag
    procedure(handle_recv_data_from_io_server) :: handling_procedure
    character(len=*), intent(in) :: name

    integer :: new_index

    io_configuration%number_inter_io_communications=io_configuration%number_inter_io_communications+1

    if (io_configuration%number_inter_io_communications .gt. size(io_configuration%inter_io_communications)) then        
      call extend_inter_io_comm_array(io_configuration)
    end if

    new_index=io_configuration%number_inter_io_communications
    io_configuration%inter_io_communications(new_index)%message_tag=message_tag+starting_tag
    io_configuration%inter_io_communications(new_index)%handling_procedure=>handling_procedure
    io_configuration%inter_io_communications(new_index)%name=name
  end subroutine register_inter_io_communication

  integer function find_inter_io_from_name(io_configuration, name)
    type(io_configuration_type), intent(inout) :: io_configuration
    character(len=*), intent(in) :: name

    integer :: i

    do i=1, io_configuration%number_inter_io_communications
      if (io_configuration%inter_io_communications(i)%name .eq. name) then
        find_inter_io_from_name=i
        return
      end if      
    end do
    find_inter_io_from_name=0
  end function find_inter_io_from_name  

  function package_inter_io_communication_message(field_name, timestep, field_values, other_int)
    character(len=STRING_LENGTH), intent(in) :: field_name
    integer, intent(in) :: timestep
    integer, intent(in), optional :: other_int
    real(kind=DEFAULT_PRECISION), dimension(:), intent(in) :: field_values
    character, dimension(:), allocatable :: package_inter_io_communication_message

    integer :: current_location
    
    allocate(package_inter_io_communication_message(string_length+8+(8*size(field_values))))
    
    current_location=pack_scalar_field(package_inter_io_communication_message, 1, string_value=field_name)
    current_location=pack_scalar_field(package_inter_io_communication_message, current_location, int_value=timestep)
    if (present(other_int)) then
      current_location=pack_scalar_field(package_inter_io_communication_message, current_location, int_value=other_int)
    end if
    current_location=pack_array_field(package_inter_io_communication_message, current_location, real_array_1d=field_values)
  end function package_inter_io_communication_message

  subroutine unpackage_inter_io_communication_message(data_buffer, field_name, timestep, field_values, other_int)
    character, dimension(:), intent(in) :: data_buffer
    character(len=STRING_LENGTH), intent(out) :: field_name
    integer, intent(out) :: timestep
    integer, intent(out), optional :: other_int
    real(kind=DEFAULT_PRECISION), dimension(:), allocatable, intent(out) :: field_values
    
    integer :: values_entries

    values_entries=(size(data_buffer) - (string_length+8))/8

    allocate(field_values(values_entries))
    field_name=transfer(data_buffer(1:string_length), field_name)
    timestep=transfer(data_buffer(string_length+1:string_length+4), timestep)
    if (present(other_int)) other_int=transfer(data_buffer(string_length+5:string_length+8), other_int)
    field_values=transfer(data_buffer(string_length+9:), field_values)
  end subroutine unpackage_inter_io_communication_message  
end module inter_io_specifics_mod