Yet Another eXchange Tool  0.9.0
xt_ut.f90
Go to the documentation of this file.
1 
12 
13 !
14 ! Keywords:
15 ! Maintainer: Jörg Behrens <behrens@dkrz.de>
16 ! Moritz Hanke <hanke@dkrz.de>
17 ! Thomas Jahns <jahns@dkrz.de>
18 ! URL: https://doc.redmine.dkrz.de/yaxt/html/
19 !
20 ! Redistribution and use in source and binary forms, with or without
21 ! modification, are permitted provided that the following conditions are
22 ! met:
23 !
24 ! Redistributions of source code must retain the above copyright notice,
25 ! this list of conditions and the following disclaimer.
26 !
27 ! Redistributions in binary form must reproduce the above copyright
28 ! notice, this list of conditions and the following disclaimer in the
29 ! documentation and/or other materials provided with the distribution.
30 !
31 ! Neither the name of the DKRZ GmbH nor the names of its contributors
32 ! may be used to endorse or promote products derived from this software
33 ! without specific prior written permission.
34 !
35 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
36 ! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
37 ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
38 ! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
39 ! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
40 ! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
41 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
42 ! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
43 ! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
44 ! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
45 ! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
46 
49 
50 MODULE xt_ut
51  !
52  ! unitrans interface for accessing yaxt
53  !
54 
55  use, INTRINSIC :: iso_c_binding, only: c_char, c_null_char, c_int, &
56  c_long, c_short, c_long_long, c_ptr, c_loc
57 
58  USE xt_core, ONLY : xt_int_kind
59  USE xt_mpi, ONLY: xt_mpi_fint_kind
60 
61  IMPLICIT NONE
62  PRIVATE
63 
64  PUBLIC :: ut_init, ut_init_decomposition, &
66  ut_init_transposition, ut_transpose, &
70 
71  PUBLIC :: xt_int_kind
72 
73  INTEGER, PARAMETER :: inflate_inner = 1
74  INTEGER, PARAMETER :: inflate_outer = 2
75 
76  INTEGER, PUBLIC, PARAMETER :: comm_forward = 1
77  INTEGER, PUBLIC, PARAMETER :: comm_backward = 2
78 
79  INTEGER, PUBLIC, PARAMETER :: ut_mode_dt_p2p = 1
80  INTEGER, PUBLIC, PARAMETER :: ut_mode_dt_alltoall = 2
81  INTEGER, PUBLIC, PARAMETER :: ut_mode_pack_p2p = 3
82  INTEGER, PUBLIC, PARAMETER :: ut_mode_pack_alltoall = 4
83 
84  INTERFACE ut_init_decomposition
85  MODULE PROCEDURE ut_init_decomposition_1d
86  END INTERFACE ut_init_decomposition
87 
88 
89  INTERFACE ut_init_transposition
90  MODULE PROCEDURE ut_init_transposition_simple
91  MODULE PROCEDURE ut_init_transposition_with_offsets
92  END INTERFACE ut_init_transposition
93 
94  INTERFACE ut_transpose
95  MODULE PROCEDURE ut_transpose_int
96  END INTERFACE ut_transpose
97 
98  INTERFACE
99  SUBROUTINE xt_ut_abort(msg, source, line) bind(C, name='xt_ut_abort')
100  import:: c_char, c_int
101  IMPLICIT NONE
102  CHARACTER(C_CHAR), DIMENSION(*), INTENT(in) :: msg
103  CHARACTER(C_CHAR), DIMENSION(*), INTENT(in) :: source
104  INTEGER(C_INT), INTENT(in) :: line
105  END SUBROUTINE xt_ut_abort
106  END INTERFACE
107 
108  INTERFACE
109  SUBROUTINE xt_ut_init(decomp_size, comm_tmpl_size, comm_size, debug_lvl, &
110  mode, idebug_unit) bind(C, name='xt_ut_init')
111  import:: c_int
112  IMPLICIT NONE
113  INTEGER(C_INT), VALUE, INTENT(in) :: decomp_size, comm_tmpl_size, &
114  comm_size, debug_lvl, mode, idebug_unit
115  END SUBROUTINE xt_ut_init
116  END INTERFACE
117 
118  INTERFACE
119  SUBROUTINE xt_ut_finalize() bind(C, name='xt_ut_finalize')
120  END SUBROUTINE xt_ut_finalize
121  END INTERFACE
122 
123  INTERFACE
124  FUNCTION xt_ut_init_decomposition_1d(idx_vec, idx_vec_n) &
125  bind(c, name='xt_ut_init_decomposition_1d') result(r)
126  import:: c_int
127  import:: xt_int_kind
128  IMPLICIT NONE
129  INTEGER(C_INT) :: r
130  INTEGER(xt_int_kind), DIMENSION(*), INTENT(in) :: idx_vec
131  INTEGER(c_int), VALUE, INTENT(in) :: idx_vec_n
132  END FUNCTION xt_ut_init_decomposition_1d
133  END INTERFACE
134 
135  INTERFACE
136  SUBROUTINE xt_ut_destroy_decomposition(handle) &
137  bind(c, name='xt_ut_destroy_decomposition')
138  import:: c_int
139  IMPLICIT NONE
140  INTEGER(C_INT), VALUE, INTENT(in) :: handle
141  END SUBROUTINE xt_ut_destroy_decomposition
142  END INTERFACE
143 
144  INTERFACE
146  decomp_handle_in, decomp_handle_out, mpi_world, check_unique) &
147  & bind(c, name='xt_ut_init_oneway_transposition_template') &
148  result(r)
149  import:: c_int
150  IMPLICIT NONE
151  INTEGER(C_INT) :: r
152  INTEGER(C_INT), VALUE, INTENT(in) :: decomp_handle_in, &
153  decomp_handle_out, mpi_world, check_unique
155  END INTERFACE
156 
157  INTERFACE
158  SUBROUTINE xt_ut_destroy_transposition_template(handle) &
159  bind(c, name='xt_ut_destroy_transposition_template')
160  import:: c_int
161  IMPLICIT NONE
162  INTEGER(C_INT), VALUE, INTENT(in) :: handle
164  END INTERFACE
165 
166  INTERFACE
167  FUNCTION xt_ut_init_transposition_simple(itemplate, datatype) &
168  bind(c, name='xt_ut_init_transposition_simple') result(rc)
169  IMPORT :: xt_mpi_fint_kind
170  IMPLICIT NONE
171  INTEGER(xt_mpi_fint_kind) :: rc
172  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: itemplate
173  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: datatype
175  END INTERFACE
176 
177  INTERFACE
178  FUNCTION xt_ut_init_transposition(itemplate, offset_in, &
179  offset_in_size, offset_out, offset_out_size, &
180  & datatype) bind(C, name='xt_ut_init_transposition') RESULT(rc)
181  IMPORT :: xt_mpi_fint_kind
182  IMPLICIT NONE
183  INTEGER(xt_mpi_fint_kind) :: rc
184  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: itemplate, &
185  offset_in_size, offset_out_size
186  INTEGER(xt_mpi_fint_kind), INTENT(in) :: offset_in(*), offset_out(*)
187  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: datatype
188  END FUNCTION xt_ut_init_transposition
189  END INTERFACE
190 
191  INTERFACE
192  SUBROUTINE xt_ut_destroy_transposition(handle) &
193  bind(c, name='xt_ut_destroy_transposition')
194  import:: c_int
195  IMPLICIT NONE
196  INTEGER(C_INT), VALUE, INTENT(in) :: handle
197  END SUBROUTINE xt_ut_destroy_transposition
198  END INTERFACE
199 
200  INTERFACE
201  SUBROUTINE xt_ut_transpose(pt_in, transposition_handle, &
202  direction, pt_out) bind(C, name='xt_ut_transpose')
203  import:: c_int, c_ptr
204  IMPLICIT NONE
205  TYPE(c_ptr), INTENT(in) :: pt_in, pt_out
206  INTEGER(C_INT), VALUE, INTENT(in) :: transposition_handle
207  INTEGER(C_INT), VALUE, INTENT(in) :: direction
208  END SUBROUTINE xt_ut_transpose
209  END INTERFACE
210 
211 
212  LOGICAL, PARAMETER :: debug = .true.
213  CHARACTER(len=*), PARAMETER :: filename = 'xt_ut.f90'
214 CONTAINS
215 
216  SUBROUTINE ut_abort(msg, source, line)
217  CHARACTER(len=*), INTENT(in) :: msg
218  CHARACTER(len=*), INTENT(in) :: source
219  INTEGER, INTENT(in) :: line
220 
221  CALL xt_ut_abort(trim(msg)//c_null_char, source, line)
222 
223  END SUBROUTINE ut_abort
224 
225  SUBROUTINE ut_finalize()
226  CALL xt_ut_finalize()
227  END SUBROUTINE ut_finalize
228 
229  SUBROUTINE ut_init(decomp_size, comm_tmpl_size, comm_size, debug_lvl, &
230  mode, debug_unit)
231  INTEGER, INTENT(in) :: decomp_size
232  INTEGER, INTENT(in) :: comm_tmpl_size
233  INTEGER, INTENT(in) :: comm_size
234  INTEGER, INTENT(in) :: debug_lvl
235  INTEGER, INTENT(in) :: mode
236  INTEGER, INTENT(in) :: debug_unit
237 
238  CALL xt_ut_init(decomp_size, comm_tmpl_size, comm_size, debug_lvl, &
239  mode, debug_unit)
240 
241  END SUBROUTINE ut_init
242 
243  SUBROUTINE ut_init_decomposition_1d(myindex, global_size, handle)
244  INTEGER, INTENT(in) :: myindex(:)
245  INTEGER, INTENT(in) :: global_size
246  INTEGER, INTENT(out) :: handle
247 
248  INTEGER(c_int) :: size_myindex_c
249  IF (huge(1_xt_int_kind) < huge(myindex)) THEN
250  IF (any(myindex > huge(1_xt_int_kind)) &
251  .OR. any(myindex < -huge(1_xt_int_kind))) &
252  CALL ut_abort('ut_init_decomposition_1d: index value not supported',&
253  filename, __line__)
254  END IF
255  IF (huge(SIZE(myindex)) > huge(1_c_int)) THEN
256  IF (SIZE(myindex) > huge(1_c_int)) &
257  CALL ut_abort('ut_init_decomposition_1: array size unsupported', &
258  filename, __line__)
259  END IF
260  size_myindex_c = int(SIZE(myindex), c_int)
261  handle = xt_ut_init_decomposition_1d(idx_vec=int(myindex, xt_int_kind), &
262  idx_vec_n=size_myindex_c)
263 
264  END SUBROUTINE ut_init_decomposition_1d
265 
266  SUBROUTINE ut_destroy_decomposition(handle)
267  INTEGER, INTENT(in) :: handle
268 
269  CALL xt_ut_destroy_decomposition(handle)
270 
271  END SUBROUTINE ut_destroy_decomposition
272 
273  SUBROUTINE ut_init_oneway_transposition_template(decomp_handle_in, &
274  decomp_handle_out, mpi_world, comm_tmpl_handle, check_unique)
275  INTEGER, INTENT(in) :: decomp_handle_in
276  INTEGER, INTENT(in) :: decomp_handle_out
277  INTEGER, INTENT(in) :: mpi_world
278  INTEGER, INTENT(out) :: comm_tmpl_handle
279  LOGICAL, OPTIONAL, INTENT(in) :: check_unique
280 
281  INTEGER :: icheck_unique
282 
283  icheck_unique = 0
284  IF (PRESENT(check_unique)) THEN
285  IF (check_unique) icheck_unique = 1
286  ENDIF
287  comm_tmpl_handle = xt_ut_init_oneway_transposition_template(&
288  decomp_handle_in, decomp_handle_out, mpi_world, icheck_unique)
289 
291 
293  INTEGER, INTENT(in) :: handle
294 
296 
297  END SUBROUTINE ut_destroy_transposition_template
298 
299  SUBROUTINE ut_init_transposition_simple(comm_template_handle, &
300  datatype, comm_handle)
301  INTEGER, INTENT(in) :: comm_template_handle
302  INTEGER, INTENT(in) :: datatype
303  INTEGER, INTENT(out) :: comm_handle
304 
305  comm_handle = xt_ut_init_transposition_simple(comm_template_handle, &
306  datatype)
307 
308  END SUBROUTINE ut_init_transposition_simple
309 
310  SUBROUTINE ut_init_transposition_with_offsets(comm_template_handle, &
311  offset_in, offset_out, datatype_in, datatype_out, comm_handle)
312  INTEGER, INTENT(in) :: comm_template_handle
313  INTEGER, INTENT(in) :: offset_in(:)
314  INTEGER, INTENT(in) :: offset_out(:)
315  INTEGER, INTENT(in) :: datatype_in
316  INTEGER, INTENT(in) :: datatype_out
317  INTEGER, INTENT(out) :: comm_handle
318 
319  INTEGER :: datatype
320 
321  IF (datatype_in /= datatype_out) THEN
322  CALL ut_abort('ut_init_transposition: &
323  &(datatype_in /= datatype_out) not supported', &
324  filename, __line__)
325  ENDIF
326 
327  datatype = datatype_in
328 
329  comm_handle = xt_ut_init_transposition(comm_template_handle, &
330  & offset_in, SIZE(offset_in), &
331  & offset_out, SIZE(offset_out), &
332  & datatype)
333 
334  END SUBROUTINE ut_init_transposition_with_offsets
335 
336  SUBROUTINE ut_destroy_transposition(handle)
337  INTEGER, INTENT(in) :: handle
338 
339  CALL xt_ut_destroy_transposition(handle)
340 
341  END SUBROUTINE ut_destroy_transposition
342 
343  SUBROUTINE ut_transpose_int(field_in, transposition_handle, direction, &
344  field_out)
345  INTEGER, POINTER :: field_in, field_out
346  INTEGER, INTENT(in) :: transposition_handle
347  INTEGER, INTENT(in) :: direction
348 
349  TYPE(c_ptr) :: pt_in, pt_out
350 
351  pt_in = c_loc(field_in)
352  pt_out = c_loc(field_out)
353  CALL xt_ut_transpose(pt_in, transposition_handle, direction, pt_out)
354 
355  END SUBROUTINE ut_transpose_int
356 
357 END MODULE xt_ut
358 !
359 ! Local Variables:
360 ! f90-continuation-indent: 5
361 ! coding: utf-8
362 ! indent-tabs-mode: nil
363 ! show-trailing-whitespace: t
364 ! require-trailing-newline: t
365 ! End:
366 !
integer, parameter, public xt_int_kind
Definition: xt_core_f.f90:54
integer, parameter xt_mpi_fint_kind
Definition: xt_mpi_f.f90:53
Definition: xt_ut.f90:50
integer, parameter, public ut_mode_pack_alltoall
Definition: xt_ut.f90:82
integer, parameter, public comm_forward
Definition: xt_ut.f90:76
subroutine, public ut_init_oneway_transposition_template(decomp_handle_in, decomp_handle_out, mpi_world, comm_tmpl_handle, check_unique)
Definition: xt_ut.f90:275
subroutine, public ut_finalize()
Definition: xt_ut.f90:226
subroutine, public ut_init(decomp_size, comm_tmpl_size, comm_size, debug_lvl, mode, debug_unit)
Definition: xt_ut.f90:231
integer, parameter, public comm_backward
Definition: xt_ut.f90:77
subroutine, public ut_abort(msg, source, line)
Definition: xt_ut.f90:217
subroutine, public ut_destroy_decomposition(handle)
Definition: xt_ut.f90:267
subroutine, public ut_destroy_transposition_template(handle)
Definition: xt_ut.f90:293
integer, parameter, public ut_mode_pack_p2p
Definition: xt_ut.f90:81
integer, parameter, public ut_mode_dt_p2p
Definition: xt_ut.f90:79
integer, parameter, public ut_mode_dt_alltoall
Definition: xt_ut.f90:80
subroutine, public ut_destroy_transposition(handle)
Definition: xt_ut.f90:337
void xt_ut_transpose(const void **pt_in, int itrans, int XT_UNUSED(direction), void **pt_out)
Definition: xt_ut_c.c:255
void xt_ut_destroy_transposition_template(int id)
Definition: xt_ut_c.c:166
void xt_ut_abort(char *msg, char *source, int *line) __attribute__((noreturn))
Definition: xt_ut_c.c:111
MPI_Fint xt_ut_init_transposition(MPI_Fint itemplate, MPI_Fint offset_in[], MPI_Fint XT_UNUSED(offset_in_size), MPI_Fint offset_out[], MPI_Fint XT_UNUSED(offset_out_size), MPI_Fint f_datatype)
Definition: xt_ut_c.c:235
MPI_Fint xt_ut_init_transposition_simple(MPI_Fint itemplate, MPI_Fint f_datatype)
Definition: xt_ut_c.c:221
void xt_ut_init(int decomp_size, int comm_tmpl_size, int comm_trans_size, int debug_lvl, int mode, int debug_unit)
Definition: xt_ut_c.c:115
MPI_Fint xt_ut_init_decomposition_1d(Xt_int *iv, int iv_n)
Definition: xt_ut_c.c:192
MPI_Fint xt_ut_init_oneway_transposition_template(int id_in, int id_out, int XT_UNUSED(mpi_world), int XT_UNUSED(icheck_unique))
Definition: xt_ut_c.c:203
void xt_ut_finalize(void)
Definition: xt_ut_c.c:133
void xt_ut_destroy_decomposition(int id)
Definition: xt_ut_c.c:148
void xt_ut_destroy_transposition(int id)
Definition: xt_ut_c.c:184