48 PROGRAM test_redist_collection_static
50 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
51 USE test_idxlist_utils,
ONLY: test_err_count
56 USE test_redist_common,
ONLY: build_odd_selection_xmap, check_redist, &
57 redist_exchanger_option
59 TYPE(xt_config) :: config
60 CHARACTER(len=*),
PARAMETER :: &
61 filename =
'test_redist_collection_static_f.f90'
64 config = redist_exchanger_option()
66 CALL simple_test(mpi_comm_world, config)
67 CALL test_repeated_redist(mpi_comm_world, config)
69 IF (test_err_count() /= 0) &
70 CALL test_abort(
"non-zero error count!", filename, __line__)
75 SUBROUTINE simple_test(comm, config)
77 INTEGER,
INTENT(in) :: comm
78 TYPE(xt_config),
INTENT(in) :: config
81 TYPE(xt_redist) :: redist, redist_coll
82 INTEGER,
PARAMETER :: src_slice_len = 5, dst_slice_len = 3
83 DOUBLE PRECISION,
PARAMETER :: &
84 src_data(src_slice_len) = (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /), &
85 ref_dst_data(dst_slice_len) = (/ 1.0d0, 3.0d0, 5.0d0 /)
86 DOUBLE PRECISION :: dst_data(dst_slice_len)
87 INTEGER(mpi_address_kind),
PARAMETER :: &
88 displacements(1) = 0_mpi_address_kind
90 xmap = build_odd_selection_xmap(src_slice_len)
98 displacements, displacements, comm, config)
103 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
107 END SUBROUTINE simple_test
109 SUBROUTINE test_repeated_redist_ds1(redist_coll)
110 TYPE(xt_redist),
INTENT(in) :: redist_coll
112 DOUBLE PRECISION,
PARAMETER :: src_data(5, 3) &
113 = reshape((/ (dble(i), i = 1, 15)/), (/ 5, 3 /)), &
115 = reshape((/ ((dble(i + j), i = 1,5,2), j = 0,10,5) /), (/ 3, 3 /))
116 DOUBLE PRECISION :: dst_data(3, 3)
118 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
119 END SUBROUTINE test_repeated_redist_ds1
121 SUBROUTINE test_repeated_redist_ds2(redist_coll)
122 TYPE(xt_redist),
INTENT(in) :: redist_coll
124 DOUBLE PRECISION,
PARAMETER :: src_data(5, 3) = reshape((/&
125 (dble(i), i = 20, 34)/), (/ 5, 3 /)), &
127 = reshape((/ ((dble(i + j), i = 1,5,2), j = 19,33,5) /), (/ 3, 3 /))
128 DOUBLE PRECISION,
SAVE :: dst_data(3, 3)
130 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
131 END SUBROUTINE test_repeated_redist_ds2
133 SUBROUTINE test_repeated_redist(comm, config)
136 INTEGER,
INTENT(in) :: comm
137 TYPE(xt_config),
INTENT(in) :: config
139 INTEGER,
PARAMETER :: num_slice = 3
140 INTEGER,
PARAMETER :: src_slice_len = 5
141 TYPE(xt_xmap) :: xmap
142 TYPE(xt_redist) :: redist, redists(num_slice), redist_coll
143 INTEGER(mpi_address_kind) :: src_displacements(num_slice), &
144 dst_displacements(num_slice), src_base, dst_base, temp
145 DOUBLE PRECISION,
TARGET :: src_template(5, 3), dst_template(3, 3)
148 xmap = build_odd_selection_xmap(src_slice_len)
156 src_displacements(1) = 0_mpi_address_kind
157 dst_displacements(1) = 0_mpi_address_kind
158 CALL mpi_get_address(src_template(1, 1), src_base, ierror)
159 CALL mpi_get_address(dst_template(1, 1), dst_base, ierror)
161 CALL mpi_get_address(src_template(1, i), temp, ierror)
162 src_displacements(i) = temp - src_base
163 CALL mpi_get_address(dst_template(1, i), temp, ierror)
164 dst_displacements(i) = temp - dst_base
168 src_displacements, dst_displacements, comm, config)
172 CALL test_repeated_redist_ds1(redist_coll)
174 CALL test_repeated_redist_ds2(redist_coll)
176 CALL test_repeated_redist_ds1(redist_coll)
179 END SUBROUTINE test_repeated_redist
181 END PROGRAM test_redist_collection_static
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_redist_delete(Xt_redist redist)
Xt_redist xt_redist_collection_static_new(Xt_redist *redists, int num_redists, const MPI_Aint src_displacements[num_redists], const MPI_Aint dst_displacements[num_redists], MPI_Comm comm)
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
void xt_xmap_delete(Xt_xmap xmap)