Yet Another eXchange Tool  0.9.0
xt_redist_logical.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 #ifdef HAVE_FC_LOGICAL_INTEROP
55  USE iso_c_binding, ONLY: c_ptr, c_loc
56 #else
57  USE iso_c_binding, ONLY: c_ptr
58 #endif
59  IMPLICIT NONE
60  PRIVATE
61  CHARACTER(len=*), PARAMETER :: filename = 'xt_redist_logical.f90'
62  INTERFACE xt_redist_s_exchange
63  MODULE PROCEDURE xt_redist_s_exchange_l_1d
64  MODULE PROCEDURE xt_redist_s_exchange_l_2d
65  MODULE PROCEDURE xt_redist_s_exchange_l_3d
66  MODULE PROCEDURE xt_redist_s_exchange_l_4d
67  MODULE PROCEDURE xt_redist_s_exchange_l_5d
68  MODULE PROCEDURE xt_redist_s_exchange_l_6d
69  MODULE PROCEDURE xt_redist_s_exchange_l_7d
70  END INTERFACE xt_redist_s_exchange
71  PUBLIC :: xt_redist_s_exchange
72  INTERFACE xt_redist_a_exchange
73  MODULE PROCEDURE xt_redist_a_exchange_l_1d
74  MODULE PROCEDURE xt_redist_a_exchange_l_2d
75  MODULE PROCEDURE xt_redist_a_exchange_l_3d
76  MODULE PROCEDURE xt_redist_a_exchange_l_4d
77  MODULE PROCEDURE xt_redist_a_exchange_l_5d
78  MODULE PROCEDURE xt_redist_a_exchange_l_6d
79  MODULE PROCEDURE xt_redist_a_exchange_l_7d
80  END INTERFACE xt_redist_a_exchange
81  PUBLIC :: xt_redist_a_exchange
82 CONTAINS
83 
84  ! see @ref xt_redist_s_exchange
85  SUBROUTINE xt_redist_s_exchange_l_1d_as(redist, src_size, src_data, &
86  dst_size, dst_data)
87  TYPE(xt_redist), INTENT(in) :: redist
88  INTEGER, INTENT(in) :: src_size, dst_size
89  LOGICAL, TARGET, INTENT(in) :: src_data(src_size)
90  LOGICAL, TARGET, INTENT(inout) :: dst_data(dst_size)
91  TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
92 #ifdef HAVE_FC_LOGICAL_INTEROP
93  src_data_cptr = c_loc(src_data)
94  dst_data_cptr = c_loc(dst_data)
95 #else
96  CALL xt_slice_c_loc(src_data, src_data_cptr)
97  CALL xt_slice_c_loc(dst_data, dst_data_cptr)
98 #endif
99  CALL xt_redist_s_exchange1(redist, src_data_cptr, dst_data_cptr)
100  END SUBROUTINE xt_redist_s_exchange_l_1d_as
101 
102  ! see @ref xt_redist_s_exchange
103  SUBROUTINE xt_redist_s_exchange_l_1d(redist, src_data, dst_data)
104  TYPE(xt_redist), INTENT(in) :: redist
105  LOGICAL, TARGET, INTENT(in) :: src_data(:)
106  LOGICAL, TARGET, INTENT(inout) :: dst_data(:)
107 
108  LOGICAL, POINTER :: src_p(:), dst_p(:)
109  LOGICAL, TARGET :: dummy(1)
110  INTEGER :: src_size, dst_size
111  src_size = SIZE(src_data)
112  dst_size = SIZE(dst_data)
113  IF (src_size > 0) THEN
114  src_p => src_data
115  ELSE
116  src_p => dummy
117  src_size = 1
118  END IF
119  IF (dst_size > 0) THEN
120  dst_p => dst_data
121  ELSE
122  dst_p => dummy
123  dst_size = 1
124  END IF
125  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
126  END SUBROUTINE xt_redist_s_exchange_l_1d
127 
128  ! see @ref xt_redist_s_exchange
129  SUBROUTINE xt_redist_s_exchange_l_2d(redist, src_data, dst_data)
130  TYPE(xt_redist), INTENT(in) :: redist
131  LOGICAL, TARGET, INTENT(in) :: src_data(:,:)
132  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:)
133 
134  LOGICAL, POINTER :: src_p(:,:), dst_p(:,:)
135  LOGICAL, TARGET :: dummy(1,1)
136  INTEGER :: src_size, dst_size
137  src_size = SIZE(src_data)
138  dst_size = SIZE(dst_data)
139  IF (src_size > 0) THEN
140  src_p => src_data
141  ELSE
142  src_p => dummy
143  src_size = 1
144  END IF
145  IF (dst_size > 0) THEN
146  dst_p => dst_data
147  ELSE
148  dst_p => dummy
149  dst_size = 1
150  END IF
151  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
152  END SUBROUTINE xt_redist_s_exchange_l_2d
153 
154  ! see @ref xt_redist_s_exchange
155  SUBROUTINE xt_redist_s_exchange_l_3d(redist, src_data, dst_data)
156  TYPE(xt_redist), INTENT(in) :: redist
157  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:)
158  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:,:)
159 
160  LOGICAL, POINTER :: src_p(:,:,:), dst_p(:,:,:)
161  LOGICAL, TARGET :: dummy(1,1,1)
162  INTEGER :: src_size, dst_size
163  src_size = SIZE(src_data)
164  dst_size = SIZE(dst_data)
165  IF (src_size > 0) THEN
166  src_p => src_data
167  ELSE
168  src_p => dummy
169  src_size = 1
170  END IF
171  IF (dst_size > 0) THEN
172  dst_p => dst_data
173  ELSE
174  dst_p => dummy
175  dst_size = 1
176  END IF
177  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
178  END SUBROUTINE xt_redist_s_exchange_l_3d
179 
180  ! see @ref xt_redist_s_exchange
181  SUBROUTINE xt_redist_s_exchange_l_4d(redist, src_data, dst_data)
182  TYPE(xt_redist), INTENT(in) :: redist
183  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:)
184  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:,:,:)
185 
186  LOGICAL, POINTER :: src_p(:,:,:,:), dst_p(:,:,:,:)
187  LOGICAL, TARGET :: dummy(1,1,1,1)
188  INTEGER :: src_size, dst_size
189  src_size = SIZE(src_data)
190  dst_size = SIZE(dst_data)
191  IF (src_size > 0) THEN
192  src_p => src_data
193  ELSE
194  src_p => dummy
195  src_size = 1
196  END IF
197  IF (dst_size > 0) THEN
198  dst_p => dst_data
199  ELSE
200  dst_p => dummy
201  dst_size = 1
202  END IF
203  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
204  END SUBROUTINE xt_redist_s_exchange_l_4d
205 
206  ! see @ref xt_redist_s_exchange
207  SUBROUTINE xt_redist_s_exchange_l_5d(redist, src_data, dst_data)
208  TYPE(xt_redist), INTENT(in) :: redist
209  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:,:)
210  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:,:,:,:)
211 
212  LOGICAL, POINTER :: src_p(:,:,:,:,:), dst_p(:,:,:,:,:)
213  LOGICAL, TARGET :: dummy(1,1,1,1,1)
214  INTEGER :: src_size, dst_size
215  src_size = SIZE(src_data)
216  dst_size = SIZE(dst_data)
217  IF (src_size > 0) THEN
218  src_p => src_data
219  ELSE
220  src_p => dummy
221  src_size = 1
222  END IF
223  IF (dst_size > 0) THEN
224  dst_p => dst_data
225  ELSE
226  dst_p => dummy
227  dst_size = 1
228  END IF
229  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
230  END SUBROUTINE xt_redist_s_exchange_l_5d
231 
232  ! see @ref xt_redist_s_exchange
233  SUBROUTINE xt_redist_s_exchange_l_6d(redist, src_data, dst_data)
234  TYPE(xt_redist), INTENT(in) :: redist
235  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:,:,:)
236  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:)
237 
238  LOGICAL, POINTER :: src_p(:,:,:,:,:,:), dst_p(:,:,:,:,:,:)
239  LOGICAL, TARGET :: dummy(1,1,1,1,1,1)
240  INTEGER :: src_size, dst_size
241  src_size = SIZE(src_data)
242  dst_size = SIZE(dst_data)
243  IF (src_size > 0) THEN
244  src_p => src_data
245  ELSE
246  src_p => dummy
247  src_size = 1
248  END IF
249  IF (dst_size > 0) THEN
250  dst_p => dst_data
251  ELSE
252  dst_p => dummy
253  dst_size = 1
254  END IF
255  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
256  END SUBROUTINE xt_redist_s_exchange_l_6d
257 
258  ! see @ref xt_redist_s_exchange
259  SUBROUTINE xt_redist_s_exchange_l_7d(redist, src_data, dst_data)
260  TYPE(xt_redist), INTENT(in) :: redist
261  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:,:,:,:)
262  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
263 
264  LOGICAL, POINTER :: src_p(:,:,:,:,:,:,:), dst_p(:,:,:,:,:,:,:)
265  LOGICAL, TARGET :: dummy(1,1,1,1,1,1,1)
266  INTEGER :: src_size, dst_size
267  src_size = SIZE(src_data)
268  dst_size = SIZE(dst_data)
269  IF (src_size > 0) THEN
270  src_p => src_data
271  ELSE
272  src_p => dummy
273  src_size = 1
274  END IF
275  IF (dst_size > 0) THEN
276  dst_p => dst_data
277  ELSE
278  dst_p => dummy
279  dst_size = 1
280  END IF
281  CALL xt_redist_s_exchange_l_1d_as(redist, src_size, src_p, dst_size, dst_p)
282  END SUBROUTINE xt_redist_s_exchange_l_7d
283 
284  ! see @ref xt_redist_a_exchange
285  SUBROUTINE xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, &
286  dst_size, dst_data, request)
287  TYPE(xt_redist), INTENT(in) :: redist
288  INTEGER, INTENT(in) :: src_size, dst_size
289  LOGICAL, TARGET, INTENT(in) :: src_data(src_size)
290  LOGICAL, TARGET, INTENT(inout) :: dst_data(dst_size)
291  TYPE(xt_request), INTENT(out) :: request
292 
293  LOGICAL, TARGET :: dummy(1)
294  TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
295  IF (src_size > 0) THEN
296 #ifdef HAVE_FC_LOGICAL_INTEROP
297  src_data_cptr = c_loc(src_data)
298 #else
299  CALL xt_slice_c_loc(src_data, src_data_cptr)
300 #endif
301  ELSE
302 #ifdef HAVE_FC_LOGICAL_INTEROP
303  src_data_cptr = c_loc(dummy)
304 #else
305  CALL xt_slice_c_loc(dummy, src_data_cptr)
306 #endif
307  END IF
308  IF (dst_size > 0) THEN
309 #ifdef HAVE_FC_LOGICAL_INTEROP
310  dst_data_cptr = c_loc(dst_data)
311 #else
312  CALL xt_slice_c_loc(dst_data, dst_data_cptr)
313 #endif
314  ELSE
315 #ifdef HAVE_FC_LOGICAL_INTEROP
316  dst_data_cptr = c_loc(dummy)
317 #else
318  CALL xt_slice_c_loc(dummy, dst_data_cptr)
319 #endif
320  END IF
321  CALL xt_redist_a_exchange1(redist, src_data_cptr, dst_data_cptr, request)
322  END SUBROUTINE xt_redist_a_exchange_l_1d_as
323 
324  ! see @ref xt_redist_a_exchange
325  SUBROUTINE xt_redist_a_exchange_l_1d(redist, src_data, dst_data, &
326  request)
327  TYPE(xt_redist), INTENT(in) :: redist
328  LOGICAL, TARGET, INTENT(in) :: src_data(:)
329  LOGICAL, 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_l_1d_as(redist, src_size, src_data, dst_size, &
341  dst_data, request)
342  END SUBROUTINE xt_redist_a_exchange_l_1d
343 
344  ! see @ref xt_redist_a_exchange
345  SUBROUTINE xt_redist_a_exchange_l_2d(redist, src_data, dst_data, &
346  request)
347  TYPE(xt_redist), INTENT(in) :: redist
348  LOGICAL, TARGET, INTENT(in) :: src_data(:,:)
349  LOGICAL, 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_l_1d_as(redist, src_size, src_data, dst_size, &
361  dst_data, request)
362  END SUBROUTINE xt_redist_a_exchange_l_2d
363 
364  ! see @ref xt_redist_a_exchange
365  SUBROUTINE xt_redist_a_exchange_l_3d(redist, src_data, dst_data, &
366  request)
367  TYPE(xt_redist), INTENT(in) :: redist
368  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:)
369  LOGICAL, 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_l_1d_as(redist, src_size, src_data, dst_size, &
381  dst_data, request)
382  END SUBROUTINE xt_redist_a_exchange_l_3d
383 
384  ! see @ref xt_redist_a_exchange
385  SUBROUTINE xt_redist_a_exchange_l_4d(redist, src_data, dst_data, &
386  request)
387  TYPE(xt_redist), INTENT(in) :: redist
388  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:)
389  LOGICAL, 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_l_1d_as(redist, src_size, src_data, dst_size, &
401  dst_data, request)
402  END SUBROUTINE xt_redist_a_exchange_l_4d
403 
404  ! see @ref xt_redist_a_exchange
405  SUBROUTINE xt_redist_a_exchange_l_5d(redist, src_data, dst_data, &
406  request)
407  TYPE(xt_redist), INTENT(in) :: redist
408  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:,:)
409  LOGICAL, 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_l_1d_as(redist, src_size, src_data, dst_size, &
421  dst_data, request)
422  END SUBROUTINE xt_redist_a_exchange_l_5d
423 
424  ! see @ref xt_redist_a_exchange
425  SUBROUTINE xt_redist_a_exchange_l_6d(redist, src_data, dst_data, &
426  request)
427  TYPE(xt_redist), INTENT(in) :: redist
428  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:,:,:)
429  LOGICAL, 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_l_1d_as(redist, src_size, src_data, dst_size, &
441  dst_data, request)
442  END SUBROUTINE xt_redist_a_exchange_l_6d
443 
444  ! see @ref xt_redist_a_exchange
445  SUBROUTINE xt_redist_a_exchange_l_7d(redist, src_data, dst_data, &
446  request)
447  TYPE(xt_redist), INTENT(in) :: redist
448  LOGICAL, TARGET, INTENT(in) :: src_data(:,:,:,:,:,:,:)
449  LOGICAL, TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
450  TYPE(xt_request), INTENT(out) :: request
451 
452  INTEGER :: src_size, dst_size
453  src_size = SIZE(src_data)
454  dst_size = SIZE(dst_data)
455 #ifdef HAVE_FC_IS_CONTIGUOUS
456  IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
457  CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
458  filename, __line__)
459 #endif
460  CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
461  dst_data, request)
462  END SUBROUTINE xt_redist_a_exchange_l_7d
463 END MODULE xt_redist_logical
464 !
465 ! Local Variables:
466 ! f90-continuation-indent: 5
467 ! coding: utf-8
468 ! mode: f90
469 ! indent-tabs-mode: nil
470 ! show-trailing-whitespace: t
471 ! require-trailing-newline: t
472 ! End:
473 !
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