Yet Another eXchange Tool 0.11.3
Loading...
Searching...
No Matches
xt_config_f.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!
48#include "fc_feature_defs.inc"
49MODULE xt_config_f
50 use, INTRINSIC :: iso_c_binding, only: c_ptr, c_null_ptr, c_int, &
51 c_char, c_null_char
52 USE xt_core, ONLY: xt_abort
53 USE xt_xmap_dist_dir_bucket_gen, ONLY: xt_xmdd_bucket_gen, &
54 xt_xmdd_bucket_gen_c2f, xt_xmdd_bucket_gen_f2c
55 IMPLICIT NONE
56 PRIVATE
57 ! note: this type must not be extended to contain any other
58 ! components, its memory pattern has to match void * exactly, which
59 ! it does because of C constraints
60 TYPE, BIND(C), PUBLIC :: xt_config
61#ifndef __G95__
62 PRIVATE
63#endif
64 TYPE(c_ptr) :: cptr = c_null_ptr
65 END TYPE xt_config
66
67 INTERFACE
68 ! this function must not be implemented in Fortran because
69 ! PGI 11.x chokes on that
70 FUNCTION xt_config_f2c(config) bind(c, name='xt_config_f2c') RESULT(p)
71 IMPORT :: c_ptr, xt_config
72 IMPLICIT NONE
73 TYPE(xt_config), INTENT(in) :: config
74 TYPE(c_ptr) :: p
75 END FUNCTION xt_config_f2c
76 END INTERFACE
77
79 PUBLIC :: xt_config_f2c
82 INTEGER, PUBLIC, PARAMETER :: &
83 xt_exchanger_irecv_send = 0, &
95 PUBLIC :: xt_config_set_mem_saving, &
97 INTEGER, PUBLIC, PARAMETER :: &
98 XT_MT_NONE = 0, &
99 xt_mt_openmp = 1
100 INTEGER, PUBLIC, PARAMETER :: &
101 XT_QUICKSORT = 0, &
102 xt_mergesort = 1
103
106
109 CHARACTER(len=*), PARAMETER :: filename = 'xt_config_f.f90'
110
111CONTAINS
112
113 FUNCTION xt_config_new() RESULT(config)
114 TYPE(xt_config) :: config
115 INTERFACE
116 FUNCTION xt_config_new_c() RESULT(config) &
117 bind(c, name='xt_config_new')
118 IMPORT :: c_ptr
119 IMPLICIT NONE
120 TYPE(c_ptr) :: config
121 END FUNCTION xt_config_new_c
122 END INTERFACE
123 config%cptr = xt_config_new_c()
124 END FUNCTION xt_config_new
125
126 SUBROUTINE xt_config_delete(config)
127 TYPE(xt_config), INTENT(in) :: config
128 INTERFACE
129 SUBROUTINE xt_config_delete_c(config) bind(c, name='xt_config_delete')
130 IMPORT :: c_ptr
131 IMPLICIT NONE
132 TYPE(c_ptr), VALUE, INTENT(in) :: config
133 END SUBROUTINE xt_config_delete_c
134 END INTERFACE
135 CALL xt_config_delete_c(config%cptr)
136 END SUBROUTINE xt_config_delete
137
138 SUBROUTINE xt_config_set_exchange_method(config, method)
139 TYPE(xt_config), INTENT(inout) :: config
140 INTEGER, INTENT(in) :: method
141 INTEGER(c_int) :: method_c
142 INTERFACE
143 SUBROUTINE xt_config_set_exchange_method_c(config, method) &
144 bind(c, name='xt_config_set_exchange_method')
145 IMPORT :: c_int, c_ptr
146 TYPE(c_ptr), VALUE :: config
147 INTEGER(c_int), VALUE :: method
148 END SUBROUTINE xt_config_set_exchange_method_c
149 END INTERFACE
150 method_c = int(method, c_int)
151 CALL xt_config_set_exchange_method_c(config%cptr, method_c)
152 END SUBROUTINE xt_config_set_exchange_method
153
154 FUNCTION xt_config_get_exchange_method(config) RESULT(method)
155 TYPE(xt_config), INTENT(in) :: config
156 INTEGER :: method
157 INTERFACE
158 FUNCTION xt_config_get_exchange_method_c(config) RESULT(method) &
159 bind(c, name='xt_config_get_exchange_method')
160 IMPORT :: c_int, c_ptr
161 TYPE(c_ptr), VALUE :: config
162 INTEGER(c_int) :: method
163 END FUNCTION xt_config_get_exchange_method_c
164 END INTERFACE
165 method = int(xt_config_get_exchange_method_c(config%cptr))
167
168 FUNCTION xt_exchanger_id_by_name(name) RESULT(exchanger_id)
169 CHARACTER(len=*), INTENT(in) :: name
170 INTEGER :: exchanger_id
171 INTERFACE
172 FUNCTION xt_exchanger_id_by_name_c(name) RESULT(exchanger_id) &
173 bind(c, name='xt_exchanger_id_by_name')
174 IMPORT :: c_char, c_int
175 CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
176 INTEGER(c_int) :: exchanger_id
177 END FUNCTION xt_exchanger_id_by_name_c
178 END INTERFACE
179 INTEGER(c_int) :: c_id
180 CHARACTER(len=1) :: name_c(LEN(name)+1)
181 INTEGER :: i, nlen
182 nlen = len(name)
183 DO i = 1, nlen
184 name_c(i) = name(i:i)
185 END DO
186 name_c(nlen+1) = c_null_char
187 c_id = xt_exchanger_id_by_name_c(name_c)
188 exchanger_id = int(c_id)
189 END FUNCTION xt_exchanger_id_by_name
190
191 FUNCTION xt_config_get_idxvec_autoconvert_size(config) RESULT(cnvsize)
192 TYPE(xt_config), INTENT(in) :: config
193 INTEGER :: cnvsize
194 INTERFACE
195 FUNCTION xt_config_get_idxvec_autoconvert_size_c(config) RESULT(cnvsize) &
196 bind(c, name='xt_config_get_idxvec_autoconvert_size')
197 IMPORT :: c_int, c_ptr
198 TYPE(c_ptr), VALUE :: config
199 INTEGER(c_int) :: cnvsize
200 END FUNCTION xt_config_get_idxvec_autoconvert_size_c
201 END INTERFACE
202 cnvsize = int(xt_config_get_idxvec_autoconvert_size_c(config%cptr))
204
205 SUBROUTINE xt_config_set_idxvec_autoconvert_size(config, cnvsize)
206 TYPE(xt_config), INTENT(inout) :: config
207 INTEGER, INTENT(in) :: cnvsize
208 INTEGER(c_int) :: cnvsize_c
209 INTERFACE
210 SUBROUTINE xt_config_set_idxvec_autoconvert_size_c(config, cnvsize) &
211 bind(c, name='xt_config_set_idxvec_autoconvert_size')
212 IMPORT :: c_int, c_ptr
213 TYPE(c_ptr), VALUE :: config
214 INTEGER(c_int), VALUE :: cnvsize
215 END SUBROUTINE xt_config_set_idxvec_autoconvert_size_c
216 END INTERFACE
217 IF (cnvsize > huge(1_c_int) .OR. cnvsize < 1) &
218 CALL xt_abort("invalid conversion size", filename, __line__)
219
220 cnvsize_c = int(cnvsize, c_int)
221 CALL xt_config_set_idxvec_autoconvert_size_c(config%cptr, cnvsize_c)
223
224 FUNCTION xt_config_get_redist_mthread_mode(config) RESULT(mt_mode)
225 TYPE(xt_config), INTENT(in) :: config
226 INTEGER :: mt_mode
227 INTERFACE
228 FUNCTION xt_config_get_redist_mthread_mode_c(config) RESULT(mt_mode) &
229 bind(c, name='xt_config_get_redist_mthread_mode')
230 IMPORT :: c_int, c_ptr
231 TYPE(c_ptr), VALUE :: config
232 INTEGER(c_int) :: mt_mode
233 END FUNCTION xt_config_get_redist_mthread_mode_c
234 END INTERFACE
235 mt_mode = int(xt_config_get_redist_mthread_mode_c(config%cptr))
237
238 SUBROUTINE xt_config_set_redist_mthread_mode(config, mt_mode)
239 TYPE(xt_config), INTENT(inout) :: config
240 INTEGER, INTENT(in) :: mt_mode
241 INTEGER(c_int) :: mt_mode_c
242 INTERFACE
243 SUBROUTINE xt_config_set_redist_mthread_mode_c(config, mt_mode) &
244 bind(c, name='xt_config_set_redist_mthread_mode')
245 IMPORT :: c_int, c_ptr
246 TYPE(c_ptr), VALUE :: config
247 INTEGER(c_int), VALUE :: mt_mode
248 END SUBROUTINE xt_config_set_redist_mthread_mode_c
249 END INTERFACE
250 IF (mt_mode > huge(1_c_int) .OR. mt_mode < 0) &
251 CALL xt_abort("invalid multi-threading mode", filename, __line__)
252
253 mt_mode_c = int(mt_mode, c_int)
254 CALL xt_config_set_redist_mthread_mode_c(config%cptr, mt_mode_c)
256
257 FUNCTION xt_config_get_sort_algorithm_id(config) RESULT(sort_algo)
258 TYPE(xt_config), INTENT(in) :: config
259 INTEGER :: sort_algo
260 INTERFACE
261 FUNCTION xt_config_get_sort_algorithm_id_c(config) RESULT(sort_algo) &
262 bind(c, name='xt_config_get_sort_algorithm_id')
263 IMPORT :: c_int, c_ptr
264 TYPE(c_ptr), VALUE :: config
265 INTEGER(c_int) :: sort_algo
266 END FUNCTION xt_config_get_sort_algorithm_id_c
267 END INTERFACE
268 sort_algo = int(xt_config_get_sort_algorithm_id_c(config%cptr))
270
271 SUBROUTINE xt_config_set_sort_algorithm_by_id(config, sort_algo)
272 TYPE(xt_config), INTENT(inout) :: config
273 INTEGER, INTENT(in) :: sort_algo
274 INTEGER(c_int) :: sort_algo_c
275 INTERFACE
276 SUBROUTINE xt_config_set_sort_algorithm_by_id_c(config, sort_algo) &
277 bind(c, name='xt_config_set_sort_algorithm_by_id')
278 IMPORT :: c_int, c_ptr
279 TYPE(c_ptr), VALUE :: config
280 INTEGER(c_int), VALUE :: sort_algo
281 END SUBROUTINE xt_config_set_sort_algorithm_by_id_c
282 END INTERFACE
283 IF (sort_algo > huge(1_c_int) .OR. sort_algo < 0) &
284 CALL xt_abort("invalid algorithm selection", filename, __line__)
285
286 sort_algo_c = int(sort_algo, c_int)
287 CALL xt_config_set_sort_algorithm_by_id_c(config%cptr, sort_algo_c)
289
305 SUBROUTINE xt_config_set_mem_saving(config, memconserve)
306 TYPE(xt_config), INTENT(inout) :: config
307 INTEGER, INTENT(in) :: memconserve
308 INTERFACE
309 SUBROUTINE xt_config_set_mem_saving_c(config, memconserve) &
310 BIND(c, name="xt_config_set_mem_saving")
311 IMPORT :: c_ptr, c_int
312 TYPE(c_ptr), VALUE :: config
313 INTEGER(c_int), VALUE :: memconserve
314 END SUBROUTINE xt_config_set_mem_saving_c
315 END INTERFACE
316 INTEGER(c_int) :: memconserve_c
317 memconserve_c = int(memconserve, c_int)
318 CALL xt_config_set_mem_saving_c(config%cptr, memconserve_c)
319 END SUBROUTINE xt_config_set_mem_saving
320
325 FUNCTION xt_config_get_mem_saving(config) RESULT(memconserve)
326 TYPE(xt_config), INTENT(in) :: config
327 INTEGER :: memconserve
328 INTERFACE
329 FUNCTION xt_config_get_mem_saving_c(config) &
330 BIND(c, name="xt_config_get_mem_saving") result(memconserve)
331 IMPORT :: c_ptr, c_int
332 TYPE(c_ptr), VALUE :: config
333 INTEGER(c_int) :: memconserve
334 END FUNCTION xt_config_get_mem_saving_c
335 END INTERFACE
336 INTEGER(c_int) :: memconserve_c
337 memconserve_c = xt_config_get_mem_saving_c(config%cptr)
338 memconserve = int(memconserve_c)
339 END FUNCTION xt_config_get_mem_saving
340
343 FUNCTION xt_config_get_xmdd_bucket_gen(config) RESULT(gen)
344 TYPE(xt_config), INTENT(in) :: config
345 TYPE(xt_xmdd_bucket_gen) :: gen
346 INTERFACE
347 FUNCTION xt_config_get_xmdd_bucket_gen_c(config) &
348 bind(c, name='xt_config_get_xmdd_bucket_gen') result(gen)
349 IMPORT :: c_ptr
350 TYPE(c_ptr), VALUE :: config
351 TYPE(c_ptr) :: gen
352 END FUNCTION xt_config_get_xmdd_bucket_gen_c
353 END INTERFACE
354 TYPE(c_ptr) :: gen_c
355 gen_c = xt_config_get_xmdd_bucket_gen_c(config%cptr)
356 gen = xt_xmdd_bucket_gen_c2f(gen_c)
358
362 SUBROUTINE xt_config_set_xmdd_bucket_gen(config, gen)
363 TYPE(xt_config), INTENT(inout) :: config
364 TYPE(xt_xmdd_bucket_gen), INTENT(in) :: gen
365 INTERFACE
366 SUBROUTINE xt_config_set_xmdd_bucket_gen_c(config, gen) &
367 bind(c, name='xt_config_set_xmdd_bucket_gen')
368 IMPORT :: c_ptr
369 TYPE(c_ptr), VALUE :: config, gen
370 END SUBROUTINE xt_config_set_xmdd_bucket_gen_c
371 END INTERFACE
372 CALL xt_config_set_xmdd_bucket_gen_c(config%cptr, &
374 END SUBROUTINE xt_config_set_xmdd_bucket_gen
375
376 SUBROUTINE xt_config_set_xmap_stripe_align(config, preference)
377 TYPE(xt_config), INTENT(inout) :: config
378 INTEGER, INTENT(in) :: preference
379 INTEGER(c_int) :: preference_c
380 INTERFACE
381 SUBROUTINE xt_config_set_xmap_stripe_align_c(config, preference) &
382 bind(c, name='xt_config_set_xmap_stripe_align')
383 IMPORT :: c_int, c_ptr
384 TYPE(c_ptr), VALUE :: config
385 INTEGER(c_int), VALUE :: preference
386 END SUBROUTINE xt_config_set_xmap_stripe_align_c
387 END INTERFACE
388 preference_c = int(preference, c_int)
389 CALL xt_config_set_xmap_stripe_align_c(config%cptr, preference_c)
391
392 FUNCTION xt_config_get_xmap_stripe_align(config) RESULT(preference)
393 TYPE(xt_config), INTENT(in) :: config
394 INTEGER :: preference
395 INTERFACE
396 FUNCTION xt_config_get_xmap_stripe_align_c(config) RESULT(preference) &
397 bind(c, name='xt_config_get_xmap_stripe_align')
398 IMPORT :: c_int, c_ptr
399 TYPE(c_ptr), VALUE :: config
400 INTEGER(c_int) :: preference
401 END FUNCTION xt_config_get_xmap_stripe_align_c
402 END INTERFACE
403 preference = int(xt_config_get_xmap_stripe_align_c(config%cptr))
405
406END MODULE xt_config_f
407!
408! Local Variables:
409! f90-continuation-indent: 5
410! coding: utf-8
411! indent-tabs-mode: nil
412! show-trailing-whitespace: t
413! require-trailing-newline: t
414! End:
415!
void xt_config_set_xmap_stripe_align(Xt_config config, int use_stripe_align)
Definition xt_config.c:389
void xt_config_set_idxvec_autoconvert_size(Xt_config config, int cnvsize)
Definition xt_config.c:333
void xt_config_set_redist_mthread_mode(Xt_config config, int mode)
Definition xt_config.c:347
int xt_exchanger_id_by_name(const char *name)
Definition xt_config.c:126
void xt_config_delete(Xt_config config)
Definition xt_config.c:85
void xt_config_set_exchange_method(Xt_config config, int method)
Definition xt_config.c:297
void xt_config_set_sort_algorithm_by_id(Xt_config config, int algo)
Definition xt_config.c:245
int xt_config_get_mem_saving(Xt_config config)
Definition xt_config.c:269
void xt_config_set_mem_saving(Xt_config config, int memconserve)
Definition xt_config.c:263
@ xt_exchanger_irecv_isend
Definition xt_config.h:77
@ xt_exchanger_irecv_isend_packed
Definition xt_config.h:78
@ xt_exchanger_irecv_isend_ddt_packed
Definition xt_config.h:81
@ xt_exchanger_neigh_alltoall
Definition xt_config.h:80
@ xt_exchanger_mix_isend_irecv
Definition xt_config.h:79
int xt_config_get_sort_algorithm_id(Xt_config config)
Definition xt_config.c:232
Xt_xmdd_bucket_gen xt_config_get_xmdd_bucket_gen(Xt_config config)
Definition xt_config.c:276
int xt_config_get_redist_mthread_mode(Xt_config config)
Definition xt_config.c:340
Xt_config xt_config_new(void)
Definition xt_config.c:78
void xt_config_set_xmdd_bucket_gen(Xt_config config, Xt_xmdd_bucket_gen bucket_gen_iface)
Definition xt_config.c:282
int xt_config_get_xmap_stripe_align(Xt_config config)
Definition xt_config.c:399
int xt_config_get_idxvec_autoconvert_size(Xt_config config)
Definition xt_config.c:327
int xt_config_get_exchange_method(Xt_config config)
Definition xt_config.c:144
Xt_xmdd_bucket_gen xt_xmdd_bucket_gen_f2c(struct xt_xmdd_bucket_gen_f *p)
Definition yaxt_f2c.c:205
Xt_config xt_config_f2c(struct xt_config_f *p)
Definition yaxt_f2c.c:190