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