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