Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_sort_f.f90
Go to the documentation of this file.
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 xt_sort
50 use, INTRINSIC :: iso_c_binding, only: c_int, c_size_t
51 USE xt_core, ONLY: xt_abort, xt_int_kind
52 IMPLICIT NONE
53 PRIVATE
54
55 INTERFACE xt_sort_int
56 SUBROUTINE xt_sort_int_f2c(a, n) bind(c, name='xt_sort_int_f2c')
57 IMPORT :: c_int, c_size_t
58 INTEGER(c_size_t), VALUE, INTENT(in) :: n
59 INTEGER(c_int), INTENT(inout) :: a(n)
60 END SUBROUTINE xt_sort_int_f2c
61 MODULE PROCEDURE xt_sort_int_a
62 END INTERFACE xt_sort_int
63 PUBLIC :: xt_sort_int
64
65 INTERFACE xt_sort_xt_int
66 SUBROUTINE xt_sort_xt_int_f2c(a, n) bind(c, name='xt_sort_xt_int_f2c')
67 IMPORT :: xt_int_kind, c_size_t
68 INTEGER(c_size_t), VALUE, INTENT(in) :: n
69 INTEGER(xt_int_kind), INTENT(inout) :: a(n)
70 END SUBROUTINE xt_sort_xt_int_f2c
71 MODULE PROCEDURE xt_sort_xt_int_a
72 END INTERFACE xt_sort_xt_int
73 PUBLIC :: xt_sort_xt_int
74
75 INTERFACE xt_sort_index
76 SUBROUTINE xt_sort_index_f2c(a, n, positions, reset_positions) &
77 bind(c, name='xt_sort_index_f2c')
78 IMPORT :: c_int, xt_int_kind
79 INTEGER(c_int), VALUE, INTENT(in) :: n, reset_positions
80 INTEGER(xt_int_kind), INTENT(inout) :: a(n)
81 INTEGER(c_int), INTENT(inout) :: positions(n)
82 END SUBROUTINE xt_sort_index_f2c
83 MODULE PROCEDURE xt_sort_index_a_a_l
84 END INTERFACE xt_sort_index
85 PUBLIC :: xt_sort_index
86
87 INTERFACE xt_sort_permutation
88#if XT_FC_XT_INT_FC_NUMERIC_KIND != XT_FC_C_INT_FC_NUMERIC_KIND
89 SUBROUTINE xt_sort_xt_int_permutation_f2c(a, n, permutation) &
90 bind(c, name='xt_sort_xt_int_permutation_f2c')
91 IMPORT :: c_int, c_size_t, xt_int_kind
92 INTEGER(c_size_t), VALUE, INTENT(in) :: n
93 INTEGER(xt_int_kind), INTENT(inout) :: a(n)
94 INTEGER(c_int), INTENT(inout) :: permutation(n)
96 MODULE PROCEDURE xt_sort_xt_int_permutation
97#endif
98 SUBROUTINE xt_sort_int_permutation_f2c(a, n, permutation) &
99 bind(c, name='xt_sort_int_permutation_f2c')
100 IMPORT :: c_int, c_size_t
101 INTEGER(c_size_t), VALUE, INTENT(in) :: n
102 INTEGER(c_int), INTENT(inout) :: a(n), permutation(n)
103 END SUBROUTINE xt_sort_int_permutation_f2c
104 MODULE PROCEDURE xt_sort_int_permutation
105 END INTERFACE xt_sort_permutation
106 PUBLIC :: xt_sort_permutation
107
108 INTERFACE xt_sort_xt_int_permutation
109 SUBROUTINE xt_sort_xt_int_permutation_f2c(a, n, permutation) &
110 bind(c, name='xt_sort_xt_int_permutation_f2c')
111 IMPORT :: c_int, c_size_t, xt_int_kind
112 INTEGER(c_size_t), VALUE, INTENT(in) :: n
113 INTEGER(xt_int_kind), INTENT(inout) :: a(n)
114 INTEGER(c_int), INTENT(inout) :: permutation(n)
115 END SUBROUTINE xt_sort_xt_int_permutation_f2c
116 MODULE PROCEDURE xt_sort_xt_int_permutation
117 END INTERFACE xt_sort_xt_int_permutation
118 PUBLIC :: xt_sort_xt_int_permutation
119
120 TYPE, BIND(c), PUBLIC :: xt_idxpos
121 INTEGER(xt_int_kind) :: idx
122 INTEGER(c_int) :: pos
123 END TYPE xt_idxpos
124
125 INTERFACE xt_sort_idxpos
126 SUBROUTINE xt_sort_idxpos_f2c(a, n) bind(c, name='xt_sort_idxpos_f2c')
127 IMPORT :: c_size_t, xt_idxpos
128 INTEGER(c_size_t), VALUE, INTENT(in) :: n
129 TYPE(xt_idxpos), INTENT(inout) :: a(n)
130 END SUBROUTINE xt_sort_idxpos_f2c
131 MODULE PROCEDURE xt_sort_idxpos_a
132 END INTERFACE xt_sort_idxpos
133 PUBLIC :: xt_sort_idxpos
134
135 INTERFACE xt_assign_id_map
136 SUBROUTINE xt_assign_id_map_int(n, a, ofs) &
137 bind(c, name='xt_assign_id_map_int')
138 IMPORT :: c_int, c_size_t
139 INTEGER(c_size_t), VALUE, INTENT(in) :: n
140 INTEGER(c_int), INTENT(out) :: a(n)
141 INTEGER(c_int), VALUE, INTENT(in) :: ofs
142 END SUBROUTINE xt_assign_id_map_int
143 MODULE PROCEDURE xt_assign_id_map_a
144 MODULE PROCEDURE xt_assign_id_map_ai
145 END INTERFACE xt_assign_id_map
146 PUBLIC :: xt_assign_id_map
147
148 CHARACTER(len=*), PARAMETER :: filename = 'xt_sort_f.f90'
149CONTAINS
150 SUBROUTINE xt_sort_int_a(a)
151 INTEGER(c_int), INTENT(inout) :: a(:)
152 INTEGER :: a_size
153 a_size = SIZE(a)
154 IF (a_size > 1) CALL xt_sort_int_f2c(a, int(a_size, c_size_t))
155 END SUBROUTINE xt_sort_int_a
156
157 SUBROUTINE xt_sort_xt_int_a(a)
158 INTEGER(xt_int_kind), INTENT(inout) :: a(:)
159 INTEGER :: a_size
160 a_size = SIZE(a)
161 IF (a_size > 1) CALL xt_sort_xt_int_f2c(a, int(a_size, c_size_t))
162 END SUBROUTINE xt_sort_xt_int_a
163
164 SUBROUTINE xt_sort_index_a_a_l(a, positions, reset_positions)
165 INTEGER(xt_int_kind), INTENT(inout) :: a(:)
166 INTEGER(c_int), INTENT(inout) :: positions(:)
167 LOGICAL, INTENT(in) :: reset_positions
168 INTEGER(c_int) :: a_size, reset_positions_c
169 a_size = int(SIZE(a), c_int)
170 reset_positions_c = merge(1_c_int, 0_c_int, reset_positions)
171 IF (a_size > SIZE(positions)) &
172 CALL xt_abort("positions array too small", filename, __line__)
173 IF (a_size > 1) CALL xt_sort_index_f2c(a, a_size, positions, &
174 reset_positions_c)
175 END SUBROUTINE xt_sort_index_a_a_l
176
177 SUBROUTINE xt_sort_idxpos_a(a)
178 TYPE(xt_idxpos), INTENT(inout) :: a(:)
179 INTEGER :: a_size
180 a_size = SIZE(a)
181 IF (a_size > 1) CALL xt_sort_idxpos_f2c(a, int(a_size, c_size_t))
182 END SUBROUTINE xt_sort_idxpos_a
183
184 SUBROUTINE xt_sort_xt_int_permutation(a, permutation)
185 INTEGER(c_int), INTENT(inout) :: a(:), permutation(:)
186 INTEGER(c_size_t) :: a_size
187#ifdef HAVE_SIZE_KIND_ARGUMENT
188 a_size = SIZE(a, kind=c_size_t)
189#else
190 a_size = int(SIZE(a), kind=c_size_t)
191#endif
192 IF (a_size > 1) CALL xt_sort_int_permutation_f2c(a, a_size, permutation)
193 END SUBROUTINE xt_sort_xt_int_permutation
194
195 SUBROUTINE xt_sort_int_permutation(a, permutation)
196 INTEGER(c_int), INTENT(inout) :: a(:), permutation(:)
197 INTEGER(c_size_t) :: a_size
198#ifdef HAVE_SIZE_KIND_ARGUMENT
199 a_size = SIZE(a, kind=c_size_t)
200#else
201 a_size = int(SIZE(a), kind=c_size_t)
202#endif
203 IF (a_size > 1) CALL xt_sort_int_permutation_f2c(a, a_size, permutation)
204 END SUBROUTINE xt_sort_int_permutation
205
206 SUBROUTINE xt_assign_id_map_a(a)
207 INTEGER(c_int), INTENT(out) :: a(:)
208 INTEGER(c_size_t) :: n
209 INTEGER(c_int) :: ofs
210#ifdef HAVE_SIZE_KIND_ARGUMENT
211 n = SIZE(a, kind=c_size_t)
212#else
213 n = int(SIZE(a), kind=c_size_t)
214#endif
215 IF (n >= 1) THEN
216 ofs = 0_c_int
217 CALL xt_assign_id_map_int(n, a, ofs)
218 END IF
219 END SUBROUTINE xt_assign_id_map_a
220
221 SUBROUTINE xt_assign_id_map_ai(a, ofs)
222 INTEGER(c_int), INTENT(out) :: a(:)
223 INTEGER(c_int), INTENT(in) :: ofs
224 INTEGER(c_size_t) :: n
225#ifdef HAVE_SIZE_KIND_ARGUMENT
226 n = SIZE(a, kind=c_size_t)
227#else
228 n = int(SIZE(a), kind=c_size_t)
229#endif
230 IF (n >= 1) THEN
231 CALL xt_assign_id_map_int(n, a, ofs)
232 END IF
233 END SUBROUTINE xt_assign_id_map_ai
234
235END MODULE xt_sort
236!
237! Local Variables:
238! f90-continuation-indent: 5
239! coding: utf-8
240! indent-tabs-mode: nil
241! show-trailing-whitespace: t
242! require-trailing-newline: t
243! End:
244!
void xt_assign_id_map_int(size_t n, int *restrict a, int ofs)
Definition xt_sort.c:77
void xt_sort_xt_int_permutation_f2c(Xt_int *a, size_t n, int *permutation)
Definition yaxt_f2c.c:170
void xt_sort_int_f2c(int *a, size_t n)
Definition yaxt_f2c.c:149
void xt_sort_xt_int_f2c(Xt_int *a, size_t n)
Definition yaxt_f2c.c:154
void xt_sort_int_permutation_f2c(int *a, size_t n, int *permutation)
Definition yaxt_f2c.c:175
void xt_sort_idxpos_f2c(idxpos_type *a, size_t n)
Definition yaxt_f2c.c:165
void xt_sort_index_f2c(Xt_int *restrict a, int n, int *restrict idx, int reset_index)
Definition yaxt_f2c.c:159