Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_idxlist_collection_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_idxlist_collection
50 USE xt_core, ONLY: xt_abort, xt_get_default_comm
51 USE xt_idxlist_abstract, ONLY: xt_idxlist, xt_idxlist_c2f
52 USE iso_c_binding, ONLY: c_int, c_ptr
53 IMPLICIT NONE
54 PRIVATE
55 INTERFACE
56 FUNCTION xt_idxlist_collection_new_c(idxlists, num_lists) &
57 bind(c, name='xt_idxlist_collection_new') result(res_ptr)
58 import:: c_ptr, c_int, xt_idxlist
59 IMPLICIT NONE
60 TYPE(xt_idxlist), INTENT(in) :: idxlists(*)
61 INTEGER(c_int), VALUE, INTENT(in) :: num_lists
62 TYPE(c_ptr) :: res_ptr
63 END FUNCTION xt_idxlist_collection_new_c
64 END INTERFACE
65
67 MODULE PROCEDURE xt_idxlist_collection_new_a1d
68 MODULE PROCEDURE xt_idxlist_collection_new_a2d
69 END INTERFACE xt_idxlist_collection_new
70
72 CHARACTER(len=*), PARAMETER :: filename = 'xt_idxlist_collection_f.f90'
73CONTAINS
74
75 FUNCTION xt_idxlist_collection_new_a1d(idxlists) RESULT(res)
76 TYPE(xt_idxlist), INTENT(in) :: idxlists(:)
77 TYPE(xt_idxlist) :: res
78 INTEGER(c_int) :: num_idxlists_c
79
80 IF (SIZE(idxlists) > huge(1_c_int)) &
81 CALL xt_abort(xt_get_default_comm(), "idxlists array too large", &
82 filename, __line__)
83 num_idxlists_c = int(SIZE(idxlists), c_int)
84 res = xt_idxlist_c2f(xt_idxlist_collection_new_c(idxlists, num_idxlists_c))
85 END FUNCTION xt_idxlist_collection_new_a1d
86
87 FUNCTION xt_idxlist_collection_new_a2d(idxlists) RESULT(res)
88 TYPE(xt_idxlist), INTENT(in) :: idxlists(:,:)
89 TYPE(xt_idxlist) :: res
90 INTEGER(c_int) :: num_idxlists_c
91
92 IF (SIZE(idxlists) > huge(1_c_int)) &
93 CALL xt_abort(xt_get_default_comm(), "idxlists array too large", &
94 filename, __line__)
95 num_idxlists_c = int(SIZE(idxlists), c_int)
96 res = xt_idxlist_c2f(xt_idxlist_collection_new_c(idxlists, num_idxlists_c))
97 END FUNCTION xt_idxlist_collection_new_a2d
98
99END MODULE xt_idxlist_collection
100!
101! Local Variables:
102! f90-continuation-indent: 5
103! coding: utf-8
104! indent-tabs-mode: nil
105! show-trailing-whitespace: t
106! require-trailing-newline: t
107! End:
108!
Xt_idxlist xt_idxlist_collection_new(Xt_idxlist *idxlists, int num_idxlists)