Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_redist_real_sp.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#include "fc_feature_defs.inc"
48MODULE xt_redist_real_sp
49 USE xt_redist_base, ONLY: xt_redist, xt_redist_s_exchange1, &
51 USE xt_requests, ONLY: xt_request
52#ifdef HAVE_FC_IS_CONTIGUOUS
53 USE xt_core, ONLY: xt_abort
54#endif
55 USE iso_c_binding, ONLY: c_ptr, c_loc
56 IMPLICIT NONE
57 PRIVATE
58 CHARACTER(len=*), PARAMETER :: filename = 'xt_redist_real_sp.f90'
59 INTEGER, PARAMETER :: ps = 6
60 INTEGER, PARAMETER :: rs = 37
61 INTEGER, PARAMETER :: sp = selected_real_kind(ps,rs)
62 PUBLIC :: sp
63 INTERFACE xt_redist_s_exchange
64 MODULE PROCEDURE xt_redist_s_exchange_sp_1d
65 MODULE PROCEDURE xt_redist_s_exchange_sp_2d
66 MODULE PROCEDURE xt_redist_s_exchange_sp_3d
67 MODULE PROCEDURE xt_redist_s_exchange_sp_4d
68 MODULE PROCEDURE xt_redist_s_exchange_sp_5d
69 MODULE PROCEDURE xt_redist_s_exchange_sp_6d
70 MODULE PROCEDURE xt_redist_s_exchange_sp_7d
71 END INTERFACE xt_redist_s_exchange
72 PUBLIC :: xt_redist_s_exchange
73 INTERFACE xt_redist_a_exchange
74 MODULE PROCEDURE xt_redist_a_exchange_sp_1d
75 MODULE PROCEDURE xt_redist_a_exchange_sp_2d
76 MODULE PROCEDURE xt_redist_a_exchange_sp_3d
77 MODULE PROCEDURE xt_redist_a_exchange_sp_4d
78 MODULE PROCEDURE xt_redist_a_exchange_sp_5d
79 MODULE PROCEDURE xt_redist_a_exchange_sp_6d
80 MODULE PROCEDURE xt_redist_a_exchange_sp_7d
81 END INTERFACE xt_redist_a_exchange
82 PUBLIC :: xt_redist_a_exchange
83CONTAINS
84
85 ! see @ref xt_redist_s_exchange
86 SUBROUTINE xt_redist_s_exchange_sp_1d_as(redist, src_size, src_data, &
87 dst_size, dst_data)
88 TYPE(xt_redist), INTENT(in) :: redist
89 INTEGER, INTENT(in) :: src_size, dst_size
90 REAL(sp), TARGET, INTENT(in) :: src_data(src_size)
91 REAL(sp), TARGET, INTENT(inout) :: dst_data(dst_size)
92 TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
93 src_data_cptr = c_loc(src_data)
94 dst_data_cptr = c_loc(dst_data)
95 CALL xt_redist_s_exchange1(redist, src_data_cptr, dst_data_cptr)
96 END SUBROUTINE xt_redist_s_exchange_sp_1d_as
97
98 ! see @ref xt_redist_s_exchange
99 SUBROUTINE xt_redist_s_exchange_sp_1d(redist, src_data, dst_data)
100 TYPE(xt_redist), INTENT(in) :: redist
101 REAL(sp), TARGET, INTENT(in) :: src_data(:)
102 REAL(sp), TARGET, INTENT(inout) :: dst_data(:)
103
104 REAL(sp), POINTER :: src_p(:), dst_p(:)
105 REAL(sp), TARGET :: dummy(1)
106 INTEGER :: src_size, dst_size
107 src_size = SIZE(src_data)
108 dst_size = SIZE(dst_data)
109 IF (src_size > 0) THEN
110 src_p => src_data
111 ELSE
112 src_p => dummy
113 src_size = 1
114 END IF
115 IF (dst_size > 0) THEN
116 dst_p => dst_data
117 ELSE
118 dst_p => dummy
119 dst_size = 1
120 END IF
121 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
122 END SUBROUTINE xt_redist_s_exchange_sp_1d
123
124 ! see @ref xt_redist_s_exchange
125 SUBROUTINE xt_redist_s_exchange_sp_2d(redist, src_data, dst_data)
126 TYPE(xt_redist), INTENT(in) :: redist
127 REAL(sp), TARGET, INTENT(in) :: src_data(:,:)
128 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:)
129
130 REAL(sp), POINTER :: src_p(:,:), dst_p(:,:)
131 REAL(sp), TARGET :: dummy(1,1)
132 INTEGER :: src_size, dst_size
133 src_size = SIZE(src_data)
134 dst_size = SIZE(dst_data)
135 IF (src_size > 0) THEN
136 src_p => src_data
137 ELSE
138 src_p => dummy
139 src_size = 1
140 END IF
141 IF (dst_size > 0) THEN
142 dst_p => dst_data
143 ELSE
144 dst_p => dummy
145 dst_size = 1
146 END IF
147 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
148 END SUBROUTINE xt_redist_s_exchange_sp_2d
149
150 ! see @ref xt_redist_s_exchange
151 SUBROUTINE xt_redist_s_exchange_sp_3d(redist, src_data, dst_data)
152 TYPE(xt_redist), INTENT(in) :: redist
153 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:)
154 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:)
155
156 REAL(sp), POINTER :: src_p(:,:,:), dst_p(:,:,:)
157 REAL(sp), TARGET :: dummy(1,1,1)
158 INTEGER :: src_size, dst_size
159 src_size = SIZE(src_data)
160 dst_size = SIZE(dst_data)
161 IF (src_size > 0) THEN
162 src_p => src_data
163 ELSE
164 src_p => dummy
165 src_size = 1
166 END IF
167 IF (dst_size > 0) THEN
168 dst_p => dst_data
169 ELSE
170 dst_p => dummy
171 dst_size = 1
172 END IF
173 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
174 END SUBROUTINE xt_redist_s_exchange_sp_3d
175
176 ! see @ref xt_redist_s_exchange
177 SUBROUTINE xt_redist_s_exchange_sp_4d(redist, src_data, dst_data)
178 TYPE(xt_redist), INTENT(in) :: redist
179 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:)
180 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:)
181
182 REAL(sp), POINTER :: src_p(:,:,:,:), dst_p(:,:,:,:)
183 REAL(sp), TARGET :: dummy(1,1,1,1)
184 INTEGER :: src_size, dst_size
185 src_size = SIZE(src_data)
186 dst_size = SIZE(dst_data)
187 IF (src_size > 0) THEN
188 src_p => src_data
189 ELSE
190 src_p => dummy
191 src_size = 1
192 END IF
193 IF (dst_size > 0) THEN
194 dst_p => dst_data
195 ELSE
196 dst_p => dummy
197 dst_size = 1
198 END IF
199 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
200 END SUBROUTINE xt_redist_s_exchange_sp_4d
201
202 ! see @ref xt_redist_s_exchange
203 SUBROUTINE xt_redist_s_exchange_sp_5d(redist, src_data, dst_data)
204 TYPE(xt_redist), INTENT(in) :: redist
205 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:,:)
206 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:)
207
208 REAL(sp), POINTER :: src_p(:,:,:,:,:), dst_p(:,:,:,:,:)
209 REAL(sp), TARGET :: dummy(1,1,1,1,1)
210 INTEGER :: src_size, dst_size
211 src_size = SIZE(src_data)
212 dst_size = SIZE(dst_data)
213 IF (src_size > 0) THEN
214 src_p => src_data
215 ELSE
216 src_p => dummy
217 src_size = 1
218 END IF
219 IF (dst_size > 0) THEN
220 dst_p => dst_data
221 ELSE
222 dst_p => dummy
223 dst_size = 1
224 END IF
225 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
226 END SUBROUTINE xt_redist_s_exchange_sp_5d
227
228 ! see @ref xt_redist_s_exchange
229 SUBROUTINE xt_redist_s_exchange_sp_6d(redist, src_data, dst_data)
230 TYPE(xt_redist), INTENT(in) :: redist
231 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:)
232 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:)
233
234 REAL(sp), POINTER :: src_p(:,:,:,:,:,:), dst_p(:,:,:,:,:,:)
235 REAL(sp), TARGET :: dummy(1,1,1,1,1,1)
236 INTEGER :: src_size, dst_size
237 src_size = SIZE(src_data)
238 dst_size = SIZE(dst_data)
239 IF (src_size > 0) THEN
240 src_p => src_data
241 ELSE
242 src_p => dummy
243 src_size = 1
244 END IF
245 IF (dst_size > 0) THEN
246 dst_p => dst_data
247 ELSE
248 dst_p => dummy
249 dst_size = 1
250 END IF
251 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
252 END SUBROUTINE xt_redist_s_exchange_sp_6d
253
254 ! see @ref xt_redist_s_exchange
255 SUBROUTINE xt_redist_s_exchange_sp_7d(redist, src_data, dst_data)
256 TYPE(xt_redist), INTENT(in) :: redist
257 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:,:)
258 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
259
260 REAL(sp), POINTER :: src_p(:,:,:,:,:,:,:), dst_p(:,:,:,:,:,:,:)
261 REAL(sp), TARGET :: dummy(1,1,1,1,1,1,1)
262 INTEGER :: src_size, dst_size
263 src_size = SIZE(src_data)
264 dst_size = SIZE(dst_data)
265 IF (src_size > 0) THEN
266 src_p => src_data
267 ELSE
268 src_p => dummy
269 src_size = 1
270 END IF
271 IF (dst_size > 0) THEN
272 dst_p => dst_data
273 ELSE
274 dst_p => dummy
275 dst_size = 1
276 END IF
277 CALL xt_redist_s_exchange_sp_1d_as(redist, src_size, src_p, dst_size, dst_p)
278 END SUBROUTINE xt_redist_s_exchange_sp_7d
279
280 ! see @ref xt_redist_a_exchange
281 SUBROUTINE xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, &
282 dst_size, dst_data, request)
283 TYPE(xt_redist), INTENT(in) :: redist
284 INTEGER, INTENT(in) :: src_size, dst_size
285 REAL(sp), TARGET, INTENT(in) :: src_data(src_size)
286 REAL(sp), TARGET, INTENT(inout) :: dst_data(dst_size)
287 TYPE(xt_request), INTENT(out) :: request
288
289 REAL(sp), TARGET :: dummy(1)
290 TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
291 IF (src_size > 0) THEN
292 src_data_cptr = c_loc(src_data)
293 ELSE
294 src_data_cptr = c_loc(dummy)
295 END IF
296 IF (dst_size > 0) THEN
297 dst_data_cptr = c_loc(dst_data)
298 ELSE
299 dst_data_cptr = c_loc(dummy)
300 END IF
301 CALL xt_redist_a_exchange1(redist, src_data_cptr, dst_data_cptr, request)
302 END SUBROUTINE xt_redist_a_exchange_sp_1d_as
303
304 ! see @ref xt_redist_a_exchange
305 SUBROUTINE xt_redist_a_exchange_sp_1d(redist, src_data, dst_data, &
306 request)
307 TYPE(xt_redist), INTENT(in) :: redist
308 REAL(sp), TARGET, INTENT(in) :: src_data(:)
309 REAL(sp), TARGET, INTENT(inout) :: dst_data(:)
310 TYPE(xt_request), INTENT(out) :: request
311
312 INTEGER :: src_size, dst_size
313 src_size = SIZE(src_data)
314 dst_size = SIZE(dst_data)
315#ifdef HAVE_FC_IS_CONTIGUOUS
316 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
317 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
318 filename, __line__)
319#endif
320 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
321 dst_data, request)
322 END SUBROUTINE xt_redist_a_exchange_sp_1d
323
324 ! see @ref xt_redist_a_exchange
325 SUBROUTINE xt_redist_a_exchange_sp_2d(redist, src_data, dst_data, &
326 request)
327 TYPE(xt_redist), INTENT(in) :: redist
328 REAL(sp), TARGET, INTENT(in) :: src_data(:,:)
329 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:)
330 TYPE(xt_request), INTENT(out) :: request
331
332 INTEGER :: src_size, dst_size
333 src_size = SIZE(src_data)
334 dst_size = SIZE(dst_data)
335#ifdef HAVE_FC_IS_CONTIGUOUS
336 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
337 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
338 filename, __line__)
339#endif
340 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
341 dst_data, request)
342 END SUBROUTINE xt_redist_a_exchange_sp_2d
343
344 ! see @ref xt_redist_a_exchange
345 SUBROUTINE xt_redist_a_exchange_sp_3d(redist, src_data, dst_data, &
346 request)
347 TYPE(xt_redist), INTENT(in) :: redist
348 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:)
349 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:)
350 TYPE(xt_request), INTENT(out) :: request
351
352 INTEGER :: src_size, dst_size
353 src_size = SIZE(src_data)
354 dst_size = SIZE(dst_data)
355#ifdef HAVE_FC_IS_CONTIGUOUS
356 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
357 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
358 filename, __line__)
359#endif
360 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
361 dst_data, request)
362 END SUBROUTINE xt_redist_a_exchange_sp_3d
363
364 ! see @ref xt_redist_a_exchange
365 SUBROUTINE xt_redist_a_exchange_sp_4d(redist, src_data, dst_data, &
366 request)
367 TYPE(xt_redist), INTENT(in) :: redist
368 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:)
369 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:)
370 TYPE(xt_request), INTENT(out) :: request
371
372 INTEGER :: src_size, dst_size
373 src_size = SIZE(src_data)
374 dst_size = SIZE(dst_data)
375#ifdef HAVE_FC_IS_CONTIGUOUS
376 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
377 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
378 filename, __line__)
379#endif
380 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
381 dst_data, request)
382 END SUBROUTINE xt_redist_a_exchange_sp_4d
383
384 ! see @ref xt_redist_a_exchange
385 SUBROUTINE xt_redist_a_exchange_sp_5d(redist, src_data, dst_data, &
386 request)
387 TYPE(xt_redist), INTENT(in) :: redist
388 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:,:)
389 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:)
390 TYPE(xt_request), INTENT(out) :: request
391
392 INTEGER :: src_size, dst_size
393 src_size = SIZE(src_data)
394 dst_size = SIZE(dst_data)
395#ifdef HAVE_FC_IS_CONTIGUOUS
396 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
397 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
398 filename, __line__)
399#endif
400 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
401 dst_data, request)
402 END SUBROUTINE xt_redist_a_exchange_sp_5d
403
404 ! see @ref xt_redist_a_exchange
405 SUBROUTINE xt_redist_a_exchange_sp_6d(redist, src_data, dst_data, &
406 request)
407 TYPE(xt_redist), INTENT(in) :: redist
408 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:)
409 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:)
410 TYPE(xt_request), INTENT(out) :: request
411
412 INTEGER :: src_size, dst_size
413 src_size = SIZE(src_data)
414 dst_size = SIZE(dst_data)
415#ifdef HAVE_FC_IS_CONTIGUOUS
416 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
417 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
418 filename, __line__)
419#endif
420 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
421 dst_data, request)
422 END SUBROUTINE xt_redist_a_exchange_sp_6d
423
424 ! see @ref xt_redist_a_exchange
425 SUBROUTINE xt_redist_a_exchange_sp_7d(redist, src_data, dst_data, &
426 request)
427 TYPE(xt_redist), INTENT(in) :: redist
428 REAL(sp), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:,:)
429 REAL(sp), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
430 TYPE(xt_request), INTENT(out) :: request
431
432 INTEGER :: src_size, dst_size
433 src_size = SIZE(src_data)
434 dst_size = SIZE(dst_data)
435#ifdef HAVE_FC_IS_CONTIGUOUS
436 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
437 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
438 filename, __line__)
439#endif
440 CALL xt_redist_a_exchange_sp_1d_as(redist, src_size, src_data, dst_size, &
441 dst_data, request)
442 END SUBROUTINE xt_redist_a_exchange_sp_7d
443END MODULE xt_redist_real_sp
444!
445! Local Variables:
446! f90-continuation-indent: 5
447! coding: utf-8
448! mode: f90
449! indent-tabs-mode: nil
450! show-trailing-whitespace: t
451! require-trailing-newline: t
452! End:
453!
void xt_redist_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data, Xt_request *request)
Definition xt_redist.c:97
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[])
Definition xt_redist.c:79
void xt_redist_a_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[], Xt_request *request)
void xt_redist_s_exchange1(Xt_redist redist, const void *src_data, void *dst_data)
Definition xt_redist.c:92