Yet Another eXchange Tool 0.11.3
Loading...
Searching...
No Matches
test_idxempty_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://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
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#include "fc_feature_defs.inc"
48PROGRAM test_idxempty
49 USE mpi
54 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
55 USE test_idxlist_utils, ONLY: check_idxlist, test_err_count, &
56 idxlist_pack_unpack_copy
57 IMPLICIT NONE
58
59 TYPE(xt_idxlist) :: idxempty, idxempty_copy
60 INTEGER(xt_int_kind) :: no_idx(1)
61 TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
62 CHARACTER(len=*), PARAMETER :: filename = 'test_idxempty_f.f90'
63
64
65 CALL init_mpi
66 CALL xt_initialize(mpi_comm_world)
67
68 idxempty = xt_idxempty_new()
69
70 CALL check_idxlist(idxempty, no_idx(1:0))
71
72 idxempty_copy = idxlist_pack_unpack_copy(idxempty)
73
74 ! check the computed intersection, must be identical to original list
75 CALL check_idxlist(idxempty_copy, no_idx(1:0))
76
77 CALL check_intersection
78
79 CALL xt_idxlist_get_index_stripes(idxempty, stripes)
80
81 IF (ALLOCATED(stripes)) &
82 CALL test_abort("unexpected non-zero amount of stripes for &
83 &empty index set", &
84 filename, __line__)
85
86 CALL check_bounding_box
87
88 CALL xt_idxlist_delete(idxempty)
89 CALL xt_idxlist_delete(idxempty_copy)
90
91 CALL xt_finalize
92 CALL finish_mpi
93
94 IF (test_err_count() /= 0) CALL test_abort("non-zero error count", &
95 filename, __line__)
96
97CONTAINS
98
99 SUBROUTINE check_intersection
100 TYPE(xt_idxlist) :: intersection
101
102 intersection = xt_idxlist_get_intersection(idxempty, idxempty_copy)
103 CALL check_idxlist(intersection, no_idx(1:0))
104 CALL xt_idxlist_delete(intersection)
105
106 END SUBROUTINE check_intersection
107
108 SUBROUTINE check_bounding_box
109 INTEGER, PARAMETER :: ndims = 3
110 INTEGER(xt_int_kind), PARAMETER :: global_start_index = 0
111 INTEGER(xt_int_kind) :: global_size(ndims)
112 TYPE(xt_bounds) :: bounds(ndims)
113
114 global_size = 10
115 bounds = xt_idxlist_get_bounding_box(idxempty, global_size, &
116 global_start_index)
117 IF (any(bounds%size /= 0)) &
118 CALL test_abort("ERROR: non-zero boundings box for xt_idxempty in &
119 &xt_idxlist_get_bounding_box", &
120 filename, __line__)
121 END SUBROUTINE check_bounding_box
122
123END PROGRAM test_idxempty
124!
125! Local Variables:
126! f90-continuation-indent: 5
127! coding: utf-8
128! indent-tabs-mode: nil
129! show-trailing-whitespace: t
130! require-trailing-newline: t
131! End:
132!
void xt_initialize(MPI_Comm default_comm)
Definition xt_init.c:70
void xt_finalize(void)
Definition xt_init.c:92
Xt_idxlist xt_idxempty_new(void)
void xt_idxlist_get_index_stripes(Xt_idxlist idxlist, struct Xt_stripe **stripes, int *num_stripes)
Definition xt_idxlist.c:135
void xt_idxlist_get_bounding_box(Xt_idxlist idxlist, unsigned ndim, const Xt_int global_size[ndim], Xt_int global_start_index, struct Xt_bounds bounds[ndim])
Definition xt_idxlist.c:379
Xt_idxlist xt_idxlist_get_intersection(Xt_idxlist idxlist_src, Xt_idxlist idxlist_dst)
void xt_idxlist_delete(Xt_idxlist idxlist)
Definition xt_idxlist.c:75