Skip to content
Snippets Groups Projects
Commit dcd52bc7 authored by Thomas Jahns's avatar Thomas Jahns :cartwheel:
Browse files

Consolidate redundant test code.

parent 6657fe70
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
tests/test_redist_common_f.f90
+ 60
− 2
View file @ dcd52bc7
......@@ -50,10 +50,12 @@ MODULE test_redist_common
USE iso_c_binding, ONLY: c_loc
USE mpi
USE yaxt, ONLY: xt_idxlist, xt_int_kind, xt_idxvec_new, xt_idxlist_delete, &
xt_xmap, xt_xmap_all2all_new, xt_redist, &
xt_xmap, xt_xmap_all2all_new, xt_redist, xt_redist_msg, xt_redist_copy, &
xt_redist_single_array_base_new, xt_redist_delete, &
xt_redist_s_exchange, xt_redist_s_exchange1, &
xt_redist_a_exchange1, &
xt_redist_a_exchange1, xt_redist_get_mpi_comm, &
xt_request, xt_request_wait, xt_request_test, xt_is_null, &
xt_redist_get_num_recv_msg, xt_redist_get_num_send_msg, &
xi => xt_int_kind
#ifdef __PGI
! PGI up to at least 15.4 has a bug that prevents proper import of
......@@ -95,8 +97,17 @@ MODULE test_redist_common
MODULE PROCEDURE wrap_a_exchange_i8
END INTERFACE wrap_a_exchange
INTERFACE test_redist_single_array_base
MODULE PROCEDURE test_redist_single_array_base_dp
END INTERFACE test_redist_single_array_base
INTERFACE check_redist_extended
MODULE PROCEDURE check_redist_extended_dp
END INTERFACE check_redist_extended
PUBLIC :: build_odd_selection_xmap, check_redist, communicators_are_congruent
PUBLIC :: check_wait_request, check_test_request, check_redist_xi
PUBLIC :: test_redist_single_array_base
CHARACTER(len=*), PARAMETER :: filename = 'test_redist_common_f.f90'
......@@ -516,6 +527,53 @@ CONTAINS
ENDDO
END SUBROUTINE check_redist_i8
SUBROUTINE test_redist_single_array_base_dp( &
send_msgs, recv_msgs, src_data, ref_dst_data, comm)
TYPE(xt_redist_msg), INTENT(in) :: send_msgs(:)
TYPE(xt_redist_msg), INTENT(in) :: recv_msgs(:)
DOUBLE PRECISION, INTENT(in) :: src_data(:)
DOUBLE PRECISION, INTENT(in) :: ref_dst_data(:)
INTEGER, INTENT(in) :: comm
TYPE(xt_redist) :: redist
INTEGER :: nsend, nrecv
redist = &
xt_redist_single_array_base_new(send_msgs, recv_msgs, comm)
nsend = SIZE(send_msgs)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
nrecv = SIZE(recv_msgs)
IF (nrecv /= xt_redist_get_num_recv_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
! test communicator of redist
IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
comm)) &
CALL test_abort("error in xt_redist_get_mpi_comm", filename, __LINE__)
CALL check_redist_extended(redist, src_data, ref_dst_data)
END SUBROUTINE test_redist_single_array_base_dp
SUBROUTINE check_redist_extended_dp(redist, src_data, ref_dst_data)
TYPE(xt_redist), INTENT(inout) :: redist
DOUBLE PRECISION, INTENT(in) :: src_data(:)
DOUBLE PRECISION, INTENT(in) :: ref_dst_data(:)
DOUBLE PRECISION :: dst_data(SIZE(ref_dst_data))
TYPE(xt_redist) :: redist_copy
! test exchange
CALL check_redist(redist, src_data, dst_data, ref_dst_data)
redist_copy = xt_redist_copy(redist)
CALL xt_redist_delete(redist)
CALL check_redist(redist_copy, src_data, dst_data, ref_dst_data)
CALL xt_redist_delete(redist_copy)
END SUBROUTINE check_redist_extended_dp
END MODULE test_redist_common
!
! Local Variables:
......
tests/test_redist_single_array_base_f.f90
+ 7
− 54
View file @ dcd52bc7
......@@ -45,13 +45,11 @@
!
PROGRAM test_redist_single_array_base_f
USE mpi
USE yaxt, ONLY: xt_redist, xt_initialize, xt_finalize, &
xt_redist_copy, xt_redist_delete, xt_redist_get_mpi_comm, &
xt_redist_msg, xt_redist_single_array_base_new, &
xt_redist_get_num_recv_msg, xt_redist_get_num_send_msg
USE yaxt, ONLY: xt_initialize, xt_finalize, xt_redist_msg
USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
USE test_redist_common, ONLY: check_redist, communicators_are_congruent
USE test_redist_common, ONLY: communicators_are_congruent, &
test_redist_single_array_base
USE test_idxlist_utils, ONLY: test_err_count
IMPLICIT NONE
CHARACTER(len=*), PARAMETER :: &
......@@ -90,7 +88,8 @@ CONTAINS
recv_msgs(1)%rank = 0
recv_msgs(1)%datatype = MPI_DOUBLE_PRECISION
CALL test_single_array_base(send_msgs, recv_msgs, src_data, ref_dst_data)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
END SUBROUTINE test_single_double
......@@ -138,7 +137,8 @@ CONTAINS
CALL test_abort("error calling mpi_type_commit", &
filename, __LINE__)
CALL test_single_array_base(send_msgs, recv_msgs, src_data, ref_dst_data)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
CALL MPI_Type_free(recv_msgs(1)%datatype, ierror)
IF (ierror /= mpi_success) &
......@@ -149,53 +149,6 @@ CONTAINS
END SUBROUTINE test_reverse_doubles
SUBROUTINE test_single_array_base( &
send_msgs, recv_msgs, src_data, ref_dst_data)
TYPE(xt_redist_msg), INTENT(IN) :: send_msgs(:)
TYPE(xt_redist_msg), INTENT(IN) :: recv_msgs(:)
DOUBLE PRECISION, INTENT(IN) :: src_data(:)
DOUBLE PRECISION, INTENT(IN) :: ref_dst_data(:)
TYPE(xt_redist) :: redist
INTEGER :: nsend, nrecv
redist = &
xt_redist_single_array_base_new(send_msgs, recv_msgs, mpi_comm_world)
nsend = SIZE(send_msgs)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
nrecv = SIZE(recv_msgs)
IF (nrecv /= xt_redist_get_num_recv_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
CALL check_redist_extended(redist, src_data, ref_dst_data)
END SUBROUTINE test_single_array_base
SUBROUTINE check_redist_extended(redist, src_data, ref_dst_data)
TYPE(xt_redist), INTENT(INOUT) :: redist
DOUBLE PRECISION, INTENT(IN) :: src_data(:)
DOUBLE PRECISION, INTENT(IN) :: ref_dst_data(:)
DOUBLE PRECISION :: dst_data(SIZE(ref_dst_data))
TYPE(xt_redist) :: redist_copy
! test communicator of redist
IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
mpi_comm_world)) &
CALL test_abort("error in xt_redist_get_mpi_comm", filename, __LINE__)
! test exchange
CALL check_redist(redist, src_data, dst_data, ref_dst_data)
redist_copy = xt_redist_copy(redist)
CALL xt_redist_delete(redist)
CALL check_redist(redist_copy, src_data, dst_data, ref_dst_data)
CALL xt_redist_delete(redist_copy)
END SUBROUTINE check_redist_extended
END PROGRAM test_redist_single_array_base_f
!
! Local Variables:
......
tests/test_redist_single_array_base_parallel_f.f90
+ 9
− 92
View file @ dcd52bc7
......@@ -45,14 +45,11 @@
!
PROGRAM test_redist_single_array_base_parallel_f
USE mpi
USE yaxt, ONLY: xt_redist, xt_initialize, xt_finalize, &
xt_redist_copy, xt_redist_delete, xt_redist_get_mpi_comm, &
xt_redist_msg, xt_redist_single_array_base_new, &
xt_redist_get_num_recv_msg, xt_redist_get_num_send_msg
USE xt_core, ONLY: i2, i4, i8
USE yaxt, ONLY: xt_initialize, xt_finalize, xt_redist_msg
USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
USE test_redist_common, ONLY: check_redist, communicators_are_congruent
USE test_redist_common, ONLY: communicators_are_congruent, &
test_redist_single_array_base
USE test_idxlist_utils, ONLY: test_err_count
IMPLICIT NONE
......@@ -100,7 +97,8 @@ CONTAINS
src_data(1) = DBLE(comm_rank)
ref_dst_data(1) = DBLE(MOD(comm_rank + comm_size - 1, comm_size))
CALL test_single_array_base(send_msgs, recv_msgs, src_data, ref_dst_data)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
END SUBROUTINE test_round_robin
......@@ -134,7 +132,8 @@ CONTAINS
ref_dst_data(i) = DBLE(i-1)
END DO
CALL test_single_array_base(send_msgs, recv_msgs, src_data, ref_dst_data)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
DO i = 1, comm_size
CALL MPI_Type_free(recv_msgs(i)%datatype, ierror)
......@@ -179,7 +178,8 @@ CONTAINS
END DO
ref_dst_data(1) = DBLE(comm_rank)
CALL test_single_array_base(send_msgs, recv_msgs, src_data, ref_dst_data)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
IF (comm_rank == 0) THEN
DO i = 1, comm_size
......@@ -191,89 +191,6 @@ CONTAINS
END SUBROUTINE test_scatter
SUBROUTINE test_single_array_base( &
send_msgs, recv_msgs, src_data, ref_dst_data)
TYPE(xt_redist_msg), INTENT(IN) :: send_msgs(:)
TYPE(xt_redist_msg), INTENT(IN) :: recv_msgs(:)
DOUBLE PRECISION, INTENT(IN) :: src_data(:)
DOUBLE PRECISION, INTENT(IN) :: ref_dst_data(:)
TYPE(xt_redist) :: redist
INTEGER :: nsend, nrecv
redist = &
xt_redist_single_array_base_new(send_msgs, recv_msgs, MPI_COMM_WORLD)
nsend = SIZE(send_msgs)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
nrecv = SIZE(recv_msgs)
IF (nrecv /= xt_redist_get_num_recv_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
CALL check_redist_extended(redist, src_data, ref_dst_data)
redist = &
xt_redist_single_array_base_new( &
INT(SIZE(send_msgs), i2), INT(SIZE(recv_msgs), i2), &
send_msgs, recv_msgs, MPI_COMM_WORLD)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
IF (nrecv /= xt_redist_get_num_recv_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
CALL check_redist_extended(redist, src_data, ref_dst_data)
redist = &
xt_redist_single_array_base_new( &
INT(SIZE(send_msgs), i4), INT(SIZE(recv_msgs), i4), &
send_msgs, recv_msgs, MPI_COMM_WORLD)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
IF (nrecv /= xt_redist_get_num_recv_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
CALL check_redist_extended(redist, src_data, ref_dst_data)
redist = &
xt_redist_single_array_base_new( &
INT(size(send_msgs), i8), INT(size(recv_msgs), i8), &
send_msgs, recv_msgs, MPI_COMM_WORLD)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
IF (nrecv /= xt_redist_get_num_recv_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
filename, __LINE__)
CALL check_redist_extended(redist, src_data, ref_dst_data)
END SUBROUTINE test_single_array_base
SUBROUTINE check_redist_extended(redist, src, ref_dst)
TYPE(xt_redist), INTENT(INOUT) :: redist
DOUBLE PRECISION, INTENT(IN) :: src(:)
DOUBLE PRECISION, INTENT(IN) :: ref_dst(:)
DOUBLE PRECISION :: dst(SIZE(ref_dst))
TYPE(xt_redist) :: redist_copy
! test communicator of redist
IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
MPI_COMM_WORLD)) &
CALL test_abort("error in xt_redist_get_mpi_comm", filename, __LINE__)
! test exchange
CALL check_redist(redist, src, dst, ref_dst)
redist_copy = xt_redist_copy(redist)
CALL xt_redist_delete(redist)
CALL check_redist(redist_copy, src, dst, ref_dst)
CALL xt_redist_delete(redist_copy)
END SUBROUTINE check_redist_extended
END PROGRAM test_redist_single_array_base_parallel_f
!
! Local Variables:
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Imprint | Privacy Policy