tem_exchange_double Subroutine

private subroutine tem_exchange_double(me, val, nComponents, comm)

Arguments

Type IntentOptional Attributes Name
type(tem_sparta_type), intent(in) :: me
real(kind=double_k), intent(inout), allocatable :: val(:)
integer, intent(in) :: nComponents
integer, intent(in) :: comm

Calls

proc~~tem_exchange_double~~CallsGraph proc~tem_exchange_double tem_exchange_double proc~tem_abort tem_abort proc~tem_exchange_double->proc~tem_abort mpi_alltoallv mpi_alltoallv proc~tem_exchange_double->mpi_alltoallv mpi_abort mpi_abort proc~tem_abort->mpi_abort

Called by

proc~~tem_exchange_double~~CalledByGraph proc~tem_exchange_double tem_exchange_double interface~tem_exchange_sparta tem_exchange_sparta interface~tem_exchange_sparta->proc~tem_exchange_double proc~exchange_elements exchange_elements proc~exchange_elements->interface~tem_exchange_sparta proc~load_tem load_tem proc~load_tem->proc~exchange_elements proc~tem_restart_readheader tem_restart_readHeader proc~tem_restart_readheader->proc~load_tem

Contents

Source Code

tem_exchange_double

Source Code

  subroutine tem_exchange_double( me, val, nComponents, comm )
    ! ---------------------------------------------------------------------------
    type( tem_sparta_type ), intent(in) :: me
    integer, intent(in) :: nComponents
    real(kind=double_k), allocatable, intent(inout) :: val(:)
    integer, intent(in) :: comm
    ! ---------------------------------------------------------------------------
    real(kind=double_k), allocatable :: old_val(:)
    integer :: iError
    ! ---------------------------------------------------------------------------

    ! Assumption check
    if ( nComponents <= 0 ) then
      write(logUnit(0),*) 'When call tem_exchange_data, nComponents <= 0!'
      write(logUnit(0),*) 'Stop!'
      call tem_abort()
    end if

    call move_alloc( val, old_val )
    allocate( val(me%new_size*nComponents) )

    call mpi_alltoallv( old_val, me%send_count*nComponents, me%send_index*nComponents, mpi_double_precision,&
                            val, me%recv_count*nComponents, me%recv_index*nComponents, mpi_double_precision,&
                        comm, ierror )

    deallocate( old_val )
  end subroutine tem_exchange_double