47#include "fc_feature_defs.inc"
49 USE iso_c_binding,
ONLY: c_int, c_ptr
50 USE xt_core,
ONLY: xt_int_kind, xt_abort, i2, i4, i8
51 USE xt_idxlist_abstract,
ONLY:
xt_idxlist, xt_idxlist_c2f
57 MODULE PROCEDURE xt_idxsection_new_a
58 MODULE PROCEDURE xt_idxsection_new_i2
59 MODULE PROCEDURE xt_idxsection_new_i4
60 MODULE PROCEDURE xt_idxsection_new_i8
64 FUNCTION xt_idxsection_new_c(start, num_dimensions, global_size, &
65 local_size, local_start) bind(c, name='xt_idxsection_new') &
67 IMPORT :: c_int, c_ptr,
xt_idxlist, xt_int_kind
68 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: start
69 INTEGER(c_int),
VALUE,
INTENT(in) :: num_dimensions
70 INTEGER(xt_int_kind),
INTENT(in) :: global_size(num_dimensions), &
71 local_start(num_dimensions)
72 INTEGER(c_int),
INTENT(in) :: local_size(num_dimensions)
73 TYPE(c_ptr) :: idxsection
74 END FUNCTION xt_idxsection_new_c
77 CHARACTER(len=*),
PARAMETER :: filename =
'xt_idxsection_f.f90'
80 FUNCTION xt_idxsection_new_a(start, global_size, local_size, local_start) &
82 INTEGER(xt_int_kind),
INTENT(in) :: start, local_start(:), global_size(:)
83 INTEGER,
INTENT(in) :: local_size(:)
85 INTEGER :: num_dimensions
86 INTEGER(c_int) :: num_dimensions_c
87 num_dimensions =
SIZE(global_size)
88 IF (
SIZE(local_size) /= num_dimensions &
89 .OR.
SIZE(local_start) /= num_dimensions) &
90 CALL xt_abort(
"non-matching array sizes", filename, __line__)
91 num_dimensions_c = int(num_dimensions, c_int)
92 idxsection = xt_idxlist_c2f(&
93 xt_idxsection_new_c(start, num_dimensions_c, global_size, &
94 & int(local_size, c_int), local_start))
95 END FUNCTION xt_idxsection_new_a
97 FUNCTION xt_idxsection_new_i2(start, num_dimensions, global_size, &
98 local_size, local_start)
RESULT(idxsection)
99 INTEGER(i2),
INTENT(in) :: num_dimensions
100 INTEGER(xt_int_kind),
INTENT(in) :: start, global_size(num_dimensions), &
101 local_start(num_dimensions)
102 INTEGER,
INTENT(in) :: local_size(num_dimensions)
104 INTEGER(c_int) :: num_dimensions_c
106 num_dimensions_c = int(num_dimensions, c_int)
107 idxsection = xt_idxlist_c2f(&
108 xt_idxsection_new_c(start, num_dimensions_c, global_size, &
109 & int(local_size, c_int), local_start))
110 END FUNCTION xt_idxsection_new_i2
112 FUNCTION xt_idxsection_new_i4(start, num_dimensions, global_size, &
113 local_size, local_start)
RESULT(idxsection)
114 INTEGER(i4),
INTENT(in) :: num_dimensions
115 INTEGER(xt_int_kind),
INTENT(in) :: start, global_size(num_dimensions), &
116 local_start(num_dimensions)
117 INTEGER,
INTENT(in) :: local_size(num_dimensions)
119 INTEGER(c_int),
PARAMETER :: dummy = 1
120 INTEGER(c_int) :: num_dimensions_c
122 IF (num_dimensions > huge(dummy)) &
123 CALL xt_abort(
"num_dimensions too large", filename, __line__)
124 num_dimensions_c = int(num_dimensions, c_int)
125 idxsection = xt_idxlist_c2f(&
126 xt_idxsection_new_c(start, num_dimensions_c, global_size, &
127 & int(local_size, c_int), local_start))
128 END FUNCTION xt_idxsection_new_i4
130 FUNCTION xt_idxsection_new_i8(start, num_dimensions, global_size, &
131 local_size, local_start)
RESULT(idxsection)
132 INTEGER(i8),
INTENT(in) :: num_dimensions
133 INTEGER(xt_int_kind),
INTENT(in) :: start, global_size(num_dimensions), &
134 local_start(num_dimensions)
135 INTEGER,
INTENT(in) :: local_size(num_dimensions)
137 INTEGER(c_int),
PARAMETER :: dummy = 1
138 INTEGER(c_int) :: num_dimensions_c
140 IF (num_dimensions > huge(dummy)) &
141 CALL xt_abort(
"num_dimensions too large", filename, __line__)
142 num_dimensions_c = int(num_dimensions, c_int)
143 idxsection = xt_idxlist_c2f(&
144 xt_idxsection_new_c(start, num_dimensions_c, global_size, &
145 & int(local_size, c_int), local_start))
146 END FUNCTION xt_idxsection_new_i8
157 FUNCTION xt_idxfsection_new(start, global_size, local_size, local_start) &
159 INTEGER(xt_int_kind),
INTENT(in) :: start, global_size(:), local_start(:)
160 INTEGER,
INTENT(in) :: local_size(:)
163 INTEGER :: idim, ndim
166 ndim =
SIZE(global_size)
167 IF (
SIZE(local_size) /= ndim .OR.
SIZE(local_start) /= ndim) &
168 CALL xt_abort(
"non-matching array sizes", filename, __line__)
173 err_state = err_state .OR. (local_start(idim) < 1) .OR. &
174 (local_start(idim) + local_size(idim) - 1 > global_size(idim))
176 IF (err_state)
CALL xt_abort(
"local indices out of global index space", &
182 global_size(ndim:1:-1), &
183 local_size(ndim:1:-1), &
184 local_start(ndim:1:-1) - 1_xt_int_kind )
186 END FUNCTION xt_idxfsection_new
188END MODULE xt_idxsection
Xt_idxlist xt_idxsection_new(Xt_int start, int num_dimensions, const Xt_int global_size[num_dimensions], const int local_size[num_dimensions], const Xt_int local_start[num_dimensions])