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