Yet Another eXchange Tool  DO_NOT_EDIT_HERE
test_idxlist_collection_f.f90
1 
12 
13 !
14 ! Keywords:
15 ! Maintainer: Jörg Behrens <behrens@dkrz.de>
16 ! Moritz Hanke <hanke@dkrz.de>
17 ! Thomas Jahns <jahns@dkrz.de>
18 ! URL: https://doc.redmine.dkrz.de/yaxt/html/
19 !
20 ! Redistribution and use in source and binary forms, with or without
21 ! modification, are permitted provided that the following conditions are
22 ! met:
23 !
24 ! Redistributions of source code must retain the above copyright notice,
25 ! this list of conditions and the following disclaimer.
26 !
27 ! Redistributions in binary form must reproduce the above copyright
28 ! notice, this list of conditions and the following disclaimer in the
29 ! documentation and/or other materials provided with the distribution.
30 !
31 ! Neither the name of the DKRZ GmbH nor the names of its contributors
32 ! may be used to endorse or promote products derived from this software
33 ! without specific prior written permission.
34 !
35 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
36 ! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
37 ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
38 ! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
39 ! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
40 ! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
41 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
42 ! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
43 ! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
44 ! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
45 ! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
46 !
47 PROGRAM test_idxlist_collection_f
48  USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
49  USE mpi
50  USE test_idxlist_utils, ONLY: check_idxlist, test_err_count, &
51  idxlist_pack_unpack_copy, check_idxlist_copy
52  USE yaxt, ONLY: xt_initialize, xt_finalize, xt_int_kind, &
53  xt_idxlist, xt_idxvec_new, &
54  xt_idxlist_collection_new, xt_idxlist_delete, xt_stripe, &
55  xt_idxlist_get_intersection, xt_idxsection_new, xt_idxstripes_new, &
56  xt_bounds, xt_idxempty_new, xt_idxlist_get_bounding_box, OPERATOR(/=)
57  IMPLICIT NONE
58 
59  CALL init_mpi
60  CALL xt_initialize(mpi_comm_world)
61 
62  CALL test_idxlist_collection_pack_unpack
63  CALL test_idxlist_collection_copy
64  CALL test_idxlist_collection_intersection
65  CALL test_idxlist_collection_heterogeneous
66  CALL test_bounding_box1
67  CALL test_bounding_box2
68 
69  CALL xt_finalize
70  IF (test_err_count() /= 0) &
71  CALL test_abort("non-zero error count!", &
72  __file__, &
73  __line__)
74  CALL finish_mpi
75 
76 CONTAINS
77  SUBROUTINE test_idxlist_collection_pack_unpack
78  INTEGER, PARAMETER :: num_indices = 7, num_vec = 2
79  INTEGER(xt_int_kind) :: i, j
80  INTEGER(xt_int_kind), PARAMETER :: index_list(num_indices, num_vec) = &
81  reshape((/ ((int(i, xt_int_kind), i = 1, num_indices), &
82  & j = 1, num_vec) /), &
83  & shape = (/ num_indices, num_vec /))
84  TYPE(xt_idxlist) :: idxlists(num_vec), collectionlist, collectionlist_copy
85  TYPE(xt_stripe), PARAMETER :: ref_stripes(num_vec) = xt_stripe(1, 1, 7)
86  INTEGER :: k
87  DO k = 1, num_vec
88  idxlists(k) = xt_idxvec_new(index_list(:, k), num_indices)
89  END DO
90  collectionlist = xt_idxlist_collection_new(idxlists)
91  CALL xt_idxlist_delete(idxlists)
92  CALL check_idxlist(collectionlist, &
93  reshape(index_list, (/ SIZE(index_list) /)))
94  collectionlist_copy = idxlist_pack_unpack_copy(collectionlist)
95  CALL check_idxlist_copy(collectionlist, collectionlist_copy, &
96  reshape(index_list, (/ SIZE(index_list) /)), ref_stripes)
97  CALL xt_idxlist_delete(collectionlist_copy)
98  CALL xt_idxlist_delete(collectionlist)
99  END SUBROUTINE test_idxlist_collection_pack_unpack
100 
101  SUBROUTINE test_idxlist_collection_copy
102  INTEGER, PARAMETER :: num_indices = 7, num_vec = 2
103  INTEGER(xt_int_kind) :: i, j
104  INTEGER(xt_int_kind), PARAMETER :: index_list(num_indices, num_vec) = &
105  reshape((/ ((int(num_indices - (j * num_indices + 1 - j - i) &
106  & * (2*j - 1), xt_int_kind), &
107  & i=1, num_indices), j=1,0,-1) /), &
108  & (/ num_indices, num_vec /))
109  TYPE(xt_idxlist) :: idxlists(num_vec), collectionlist, collectionlist_copy
110  TYPE(xt_stripe), PARAMETER :: ref_stripes(num_vec) &
111  = (/ xt_stripe(1, 1, 7), xt_stripe(7, -1, 7) /)
112  INTEGER :: k
113  DO k = 1, num_vec
114  idxlists(k) = xt_idxvec_new(index_list(:, k), num_indices)
115  END DO
116  collectionlist = xt_idxlist_collection_new(idxlists)
117  CALL xt_idxlist_delete(idxlists)
118  CALL check_idxlist(collectionlist, &
119  reshape(index_list, (/ SIZE(index_list) /)))
120  collectionlist_copy = idxlist_pack_unpack_copy(collectionlist)
121  CALL check_idxlist_copy(collectionlist, collectionlist_copy, &
122  reshape(index_list, (/ SIZE(index_list) /)), ref_stripes)
123  CALL xt_idxlist_delete(collectionlist_copy)
124  CALL xt_idxlist_delete(collectionlist)
125  END SUBROUTINE test_idxlist_collection_copy
126 
127  SUBROUTINE test_idxlist_collection_intersection
128  INTEGER, PARAMETER :: num_indices = 7, num_lists = 3
129  INTEGER, PARAMETER :: xi = xt_int_kind
130  INTEGER(xt_int_kind), PARAMETER :: index_list(num_indices, num_lists) &
131  = reshape((/ 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi, &
132  & 7_xi, 6_xi, 5_xi, 4_xi, 3_xi, 2_xi, 1_xi, &
133  & 2_xi, 6_xi, 1_xi, 4_xi, 7_xi, 3_xi, 0_xi /), &
134  & (/ num_indices, num_lists /)), &
135  sorted_index_list(SIZE(index_list)) &
136  = (/ 0_xi, 1_xi, 1_xi, 1_xi, 2_xi, 2_xi, 2_xi, &
137  & 3_xi, 3_xi, 3_xi, 4_xi, 4_xi, 4_xi, 5_xi, &
138  & 5_xi, 6_xi, 6_xi, 6_xi, 7_xi, 7_xi, 7_xi /)
139  TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist, intersection, &
140  ref_idxvec
141  INTEGER :: i
142 
143  DO i = 1, 3
144  idxlists(i) = xt_idxvec_new(index_list(:, i), num_indices)
145  END DO
146  collectionlist = xt_idxlist_collection_new(idxlists)
147  DO i = 1, 3
148  CALL xt_idxlist_delete(idxlists(i))
149  END DO
150  CALL check_idxlist(collectionlist, &
151  reshape(index_list, (/ SIZE(index_list) /)))
152  ref_idxvec = xt_idxvec_new(reshape(index_list, (/ SIZE(index_list) /)), &
153  SIZE(index_list))
154  intersection = xt_idxlist_get_intersection(ref_idxvec, collectionlist)
155  CALL check_idxlist(intersection, sorted_index_list)
156  CALL xt_idxlist_delete(intersection)
157  intersection = xt_idxlist_get_intersection(collectionlist, ref_idxvec)
158  CALL check_idxlist(intersection, sorted_index_list)
159  CALL xt_idxlist_delete(intersection)
160  CALL xt_idxlist_delete(ref_idxvec)
161  CALL xt_idxlist_delete(collectionlist)
162 
163  END SUBROUTINE test_idxlist_collection_intersection
164 
165  SUBROUTINE test_idxlist_collection_heterogeneous
166  INTEGER, PARAMETER :: num_indices = 6, num_lists = 3
167  INTEGER, PARAMETER :: xi = xt_int_kind
168  INTEGER(xt_int_kind), PARAMETER :: &
169  index_list(num_indices) = (/ 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, 11_xi /)
170  TYPE(xt_stripe), PARAMETER :: stripes(2) = (/ xt_stripe(0, 2, 5), &
171  xt_stripe(1, 2, 5) /)
172  INTEGER(xt_int_kind), PARAMETER :: local_start(2) = 2
173  INTEGER(xt_int_kind), PARAMETER :: global_size(2) = (/ 10_xi, 10_xi /)
174  INTEGER, PARAMETER :: local_size(2) = 5
175  INTEGER, PARAMETER :: ref_size = num_indices + stripes(1)%nstrides &
176  + stripes(2)%nstrides + local_size(1) * local_size(2)
177  INTEGER(xt_int_kind), PARAMETER :: ref_index_list(ref_size) &
178  = (/ 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, 11_xi, &
179  & 0_xi, 2_xi, 4_xi, 6_xi, 8_xi, 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, &
180  & 22_xi, 23_xi, 24_xi, 25_xi, 26_xi, &
181  & 32_xi, 33_xi, 34_xi, 35_xi, 36_xi, &
182  & 42_xi, 43_xi, 44_xi, 45_xi, 46_xi, &
183  & 52_xi, 53_xi, 54_xi, 55_xi, 56_xi, &
184  & 62_xi, 63_xi, 64_xi, 65_xi, 66_xi /)
185  TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
186 
187  idxlists(1) = xt_idxvec_new(index_list, SIZE(index_list))
188  idxlists(2) = xt_idxstripes_new(stripes, SIZE(stripes))
189  idxlists(3) = xt_idxsection_new(0_xt_int_kind, global_size, local_size, &
190  local_start)
191 
192  ! generate a collection index list
193  collectionlist = xt_idxlist_collection_new(idxlists)
194 
195  CALL xt_idxlist_delete(idxlists)
196 
197  ! test generated collection list
198  CALL check_idxlist(collectionlist, ref_index_list)
199 
200  CALL xt_idxlist_delete(collectionlist)
201 
202  END SUBROUTINE test_idxlist_collection_heterogeneous
203 
204  SUBROUTINE test_bounding_box1
205  INTEGER, PARAMETER :: ndim=3, num_lists = 2
206  INTEGER(xt_int_kind), PARAMETER :: global_size_bb(ndim) = 4, &
207  global_start_index = 0
208  TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
209  TYPE(xt_bounds) :: bounds(ndim)
210  INTEGER :: i
211 
212  DO i = 1, num_lists
213  idxlists(i) = xt_idxempty_new()
214  END DO
215  collectionlist = xt_idxlist_collection_new(idxlists)
216  CALL xt_idxlist_delete(idxlists)
217  bounds = xt_idxlist_get_bounding_box(collectionlist, global_size_bb, &
218  global_start_index)
219  IF (any(bounds%size /= 0)) &
220  CALL test_abort("ERROR: non-zero bounding box size", &
221  __file__, &
222  __line__)
223  CALL xt_idxlist_delete(collectionlist)
224  END SUBROUTINE test_bounding_box1
225 
226  SUBROUTINE test_bounding_box2
227  INTEGER, PARAMETER :: ndim = 3, num_lists = 2, num_indices = 3
228  INTEGER, PARAMETER :: xi = xt_int_kind
229  INTEGER(xt_int_kind), PARAMETER :: indices(num_indices, num_lists) &
230  = reshape( (/ 45_xi, 35_xi, 32_xi, 32_xi, 48_xi, 33_xi /), &
231  & (/ num_indices, num_lists /)), &
232  global_size(ndim) = (/ 5_xi, 4_xi, 3_xi /), &
233  global_start_index = 1
234  TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
235  TYPE(xt_bounds) :: bounds(ndim)
236  TYPE(xt_bounds), PARAMETER :: bounds_ref(ndim) = (/ xt_bounds(2, 2), &
237  xt_bounds(2, 2), xt_bounds(1, 2) /)
238  INTEGER :: i
239 
240  DO i = 1, num_lists
241  idxlists(i) = xt_idxvec_new(indices(:, i), SIZE(indices, 1))
242  END DO
243  collectionlist = xt_idxlist_collection_new(idxlists)
244  CALL xt_idxlist_delete(idxlists)
245 
246  bounds = xt_idxlist_get_bounding_box(collectionlist, global_size, &
247  global_start_index)
248  CALL xt_idxlist_delete(collectionlist)
249  IF (any(bounds /= bounds_ref)) &
250  CALL test_abort("ERROR: unexpected boundaries", &
251  __file__, &
252  __line__)
253  END SUBROUTINE test_bounding_box2
254 
255 END PROGRAM test_idxlist_collection_f
256 !
257 ! Local Variables:
258 ! f90-continuation-indent: 5
259 ! coding: utf-8
260 ! indent-tabs-mode: nil
261 ! show-trailing-whitespace: t
262 ! require-trailing-newline: t
263 ! End:
264 !
Generated by   doxygen 1.8.13