Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
test_xmap_common_f.f90
1
13
14!
15! Keywords:
16! Maintainer: Jörg Behrens <behrens@dkrz.de>
17! Moritz Hanke <hanke@dkrz.de>
18! Thomas Jahns <jahns@dkrz.de>
19! URL: https://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
20!
21! Redistribution and use in source and binary forms, with or without
22! modification, are permitted provided that the following conditions are
23! met:
24!
25! Redistributions of source code must retain the above copyright notice,
26! this list of conditions and the following disclaimer.
27!
28! Redistributions in binary form must reproduce the above copyright
29! notice, this list of conditions and the following disclaimer in the
30! documentation and/or other materials provided with the distribution.
31!
32! Neither the name of the DKRZ GmbH nor the names of its contributors
33! may be used to endorse or promote products derived from this software
34! without specific prior written permission.
35!
36! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
37! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
38! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
39! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
40! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
41! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
42! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
43! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
44! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
45! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
46! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
47!
48#include "fc_feature_defs.inc"
49MODULE test_xmap_common
50 USE iso_c_binding, ONLY: c_int
51 USE mpi
52 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
53 USE test_idxlist_utils, ONLY: test_err_count
54 USE yaxt, ONLY: xt_initialize, xt_finalize, xt_int_kind, &
56 xt_idxstripes_new, xi => xt_int_kind, &
61 IMPLICIT NONE
62 PRIVATE
63 INTEGER :: my_rank
64 PUBLIC :: xmap_self_test_main, test_self_xmap_construct
65 INTERFACE test_self_xmap_construct
66 MODULE PROCEDURE test_self_xmap_construct_idxlist
67 MODULE PROCEDURE test_self_xmap_construct_indices
68 MODULE PROCEDURE test_self_xmap_construct_stripes
69 END INTERFACE test_self_xmap_construct
70 CHARACTER(len=*), PARAMETER :: filename = 'test_xmap_common_f.f90'
71CONTAINS
72 SUBROUTINE xmap_self_test_main(xmap_new)
73 INTERFACE
74 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
75 IMPORT :: xt_idxlist, xt_xmap
76 IMPLICIT NONE
77 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
78 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
79 INTEGER, INTENT(in) :: comm
80 TYPE(xt_xmap) :: res
81 END FUNCTION xmap_new
82 END INTERFACE
83 INTEGER :: ierror, i, j
84 INTEGER :: comms(2)
85 INTEGER(xi), PARAMETER :: lsize(2) = (/ 7_xi, 1023_xi /)
86
87 CALL init_mpi
88 CALL xt_initialize(mpi_comm_world)
89 CALL mpi_comm_rank(mpi_comm_world, my_rank, ierror)
90 IF (ierror /= mpi_success) &
91 CALL test_abort("MPI error!", filename, __line__)
92
93 comms(1) = mpi_comm_world
94 CALL mpi_comm_dup(mpi_comm_world, comms(2), ierror)
95 IF (ierror /= mpi_success) &
96 CALL test_abort("MPI error!", filename, __line__)
97 CALL xt_mpi_comm_mark_exclusive(comms(2))
98
99 DO i = 1, SIZE(comms)
100 DO j = 1, 2
101 CALL test_xmap1a(xmap_new, lsize(j), comms(i))
102 CALL test_xmap1b(xmap_new, lsize(j), comms(i))
103 END DO
104 CALL test_xmap2(xmap_new, comms(i))
105 END DO
106
107 CALL mpi_comm_free(comms(2), ierror)
108 IF (ierror /= mpi_success) &
109 CALL test_abort("MPI error!", filename, __line__)
110
111 IF (test_err_count() /= 0) &
112 CALL test_abort("non-zero error count!", filename, __line__)
113 CALL xt_finalize
114 CALL finish_mpi
115 END SUBROUTINE xmap_self_test_main
116
117 SUBROUTINE shift_idx(idx, offset)
118 INTEGER(xi), INTENT(inout) :: idx(:)
119 INTEGER(xi), INTENT(in) :: offset
120 INTEGER :: i
121 DO i = 1, SIZE(idx)
122 idx(i) = idx(i) + int(my_rank, xi) * offset
123 END DO
124 END SUBROUTINE shift_idx
125
126 SUBROUTINE assert_xmap_is_to_self(xmap)
127 TYPE(xt_xmap) :: xmap
128 INTEGER :: rank(1)
129 IF (xt_xmap_get_num_destinations(xmap) /= 1) &
130 CALL test_abort("error in xmap construction", filename, __line__)
131
132 IF (xt_xmap_get_num_sources(xmap) /= 1) &
133 CALL test_abort("error in xt_xmap_get_num_sources", filename, __line__)
134 CALL xt_xmap_get_destination_ranks(xmap, rank)
135 IF (rank(1) /= my_rank) &
136 CALL test_abort("error in xt_xmap_get_destination_ranks", &
137 filename, __line__)
138
139 CALL xt_xmap_get_source_ranks(xmap, rank)
140 IF (rank(1) /= my_rank) &
141 CALL test_abort("error in xt_xmap_get_source_ranks", &
142 filename, __line__)
143
144 END SUBROUTINE assert_xmap_is_to_self
145
146 SUBROUTINE test_self_xmap_construct_stripes(src_stripes, dst_stripes, &
147 xmap_new, comm)
148 TYPE(xt_stripe), INTENT(in) :: src_stripes(:), dst_stripes(:)
149 INTERFACE
150 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
151 IMPORT :: xt_idxlist, xt_xmap
152 IMPLICIT NONE
153 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
154 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
155 INTEGER, INTENT(in) :: comm
156 TYPE(xt_xmap) :: res
157 END FUNCTION xmap_new
158 END INTERFACE
159 INTEGER, INTENT(in) :: comm
160 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
161 src_idxlist = xt_idxstripes_new(src_stripes)
162 dst_idxlist = xt_idxstripes_new(dst_stripes)
163 CALL test_self_xmap_construct(src_idxlist, dst_idxlist, xmap_new, comm)
164 END SUBROUTINE test_self_xmap_construct_stripes
165
166 SUBROUTINE test_self_xmap_construct_indices(src_indices, dst_indices, &
167 xmap_new, comm)
168 INTEGER(xi), INTENT(in) :: src_indices(:), dst_indices(:)
169 INTERFACE
170 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
171 IMPORT :: xt_idxlist, xt_xmap
172 IMPLICIT NONE
173 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
174 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
175 INTEGER, INTENT(in) :: comm
176 TYPE(xt_xmap) :: res
177 END FUNCTION xmap_new
178 END INTERFACE
179 INTEGER, INTENT(in) :: comm
180 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
181 src_idxlist = xt_idxvec_new(src_indices)
182 dst_idxlist = xt_idxvec_new(dst_indices)
183 CALL test_self_xmap_construct(src_idxlist, dst_idxlist, xmap_new, comm)
184 END SUBROUTINE test_self_xmap_construct_indices
185
186 SUBROUTINE test_self_xmap_construct_idxlist(src_idxlist, dst_idxlist, &
187 xmap_new, comm)
188 TYPE(xt_idxlist), INTENT(inout) :: src_idxlist, dst_idxlist
189 INTERFACE
190 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
191 IMPORT :: xt_idxlist, xt_xmap
192 IMPLICIT NONE
193 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
194 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
195 INTEGER, INTENT(in) :: comm
196 TYPE(xt_xmap) :: res
197 END FUNCTION xmap_new
198 END INTERFACE
199 INTEGER, INTENT(in) :: comm
200
201 TYPE(xt_xmap) :: xmap, xmap_copy
202
203 xmap = xmap_new(src_idxlist, dst_idxlist, comm)
204 CALL xt_idxlist_delete(src_idxlist)
205 CALL xt_idxlist_delete(dst_idxlist)
206
207 CALL assert_xmap_is_to_self(xmap)
208 xmap_copy = xt_xmap_copy(xmap)
209 CALL assert_xmap_is_to_self(xmap_copy)
210
211 CALL xt_xmap_delete(xmap)
212 CALL xt_xmap_delete(xmap_copy)
213 END SUBROUTINE test_self_xmap_construct_idxlist
214
215 SUBROUTINE test_xmap1a(xmap_new, lsize, comm)
216 INTERFACE
217 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
218 IMPORT :: xt_idxlist, xt_xmap
219 IMPLICIT NONE
220 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
221 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
222 INTEGER, INTENT(in) :: comm
223 TYPE(xt_xmap) :: res
224 END FUNCTION xmap_new
225 END INTERFACE
226 INTEGER(xi), INTENT(in) :: lsize
227 INTEGER, INTENT(in) :: comm
228
229 INTEGER(xt_int_kind) :: src_indices(lsize), dst_indices(lsize), i
230 DO i = 1_xi, lsize
231 src_indices(i) = i
232 END DO
233 CALL shift_idx(src_indices, lsize)
234 DO i = 1_xi, lsize
235 dst_indices(i) = lsize - i + 1_xi
236 END DO
237 CALL shift_idx(dst_indices, lsize)
238
239 CALL test_self_xmap_construct(src_indices, dst_indices, &
240 xmap_new, comm)
241 END SUBROUTINE test_xmap1a
242
243 SUBROUTINE test_xmap1b(xmap_new, lsize, comm)
244 INTERFACE
245 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
246 IMPORT :: xt_idxlist, xt_xmap
247 IMPLICIT NONE
248 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
249 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
250 INTEGER, INTENT(in) :: comm
251 TYPE(xt_xmap) :: res
252 END FUNCTION xmap_new
253 END INTERFACE
254 INTEGER(xi), INTENT(in) :: lsize
255 INTEGER, INTENT(in) :: comm
256
257 TYPE(xt_stripe) :: src_stripe(1), dst_stripe(1)
258 src_stripe(1) = xt_stripe(1_xi + int(my_rank, xi) * lsize, &
259 1_xi, int(lsize, c_int))
260 dst_stripe(1) = xt_stripe(int(my_rank+1, xi) * lsize, &
261 -1_xi, int(lsize, c_int))
262 CALL test_self_xmap_construct(src_stripe, dst_stripe, &
263 xmap_new, comm)
264 END SUBROUTINE test_xmap1b
265
266 SUBROUTINE test_xmap2(xmap_new, comm)
267 INTERFACE
268 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
269 IMPORT :: xt_idxlist, xt_xmap
270 IMPLICIT NONE
271 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
272 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
273 INTEGER, INTENT(in) :: comm
274 TYPE(xt_xmap) :: res
275 END FUNCTION xmap_new
276 END INTERFACE
277 INTEGER, INTENT(in) :: comm
278
279 INTEGER(xi) :: src_index_list(14), dst_index_list(13)
280 src_index_list = &
281 (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
282 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
283 & 13_xi, 12_xi, 1_xi, 3_xi /)
284 dst_index_list = &
285 (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
286 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
287 & 13_xi, 2_xi, 1_xi /)
288 CALL test_self_xmap_construct(src_index_list, dst_index_list, xmap_new, comm)
289 END SUBROUTINE test_xmap2
290
291END MODULE test_xmap_common
292!
293! Local Variables:
294! f90-continuation-indent: 5
295! coding: utf-8
296! indent-tabs-mode: nil
297! show-trailing-whitespace: t
298! require-trailing-newline: t
299! End:
300!
void xt_initialize(MPI_Comm default_comm)
Definition xt_init.c:70
void xt_finalize(void)
Definition xt_init.c:92
void xt_idxlist_delete(Xt_idxlist idxlist)
Definition xt_idxlist.c:75
Xt_idxlist xt_idxstripes_new(struct Xt_stripe const *stripes, int num_stripes)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
Definition xt_idxvec.c:213
void xt_mpi_comm_mark_exclusive(MPI_Comm comm)
Definition xt_mpi.c:403
void xt_xmap_delete(Xt_xmap xmap)
Definition xt_xmap.c:86
int xt_xmap_get_num_destinations(Xt_xmap xmap)
Definition xt_xmap.c:61
Xt_xmap xt_xmap_copy(Xt_xmap xmap)
Definition xt_xmap.c:81
int xt_xmap_get_num_sources(Xt_xmap xmap)
Definition xt_xmap.c:66
void xt_xmap_get_source_ranks(Xt_xmap xmap, int *ranks)
Definition xt_xmap.c:76
void xt_xmap_get_destination_ranks(Xt_xmap xmap, int *ranks)
Definition xt_xmap.c:71