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