1 /*
2 * Copyright (c) 2017, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 #include "stdioInterf.h"
19 #include "fioMacros.h"
20
21 extern void (*__fort_local_scatter[__NTYPES])();
22 extern void (*__fort_local_gathscat[__NTYPES])();
23
24 /* local scatter functions */
25
26 void
local_scatter_WRAPPER(int n,void * dst,int * sv,void * src,__INT_T kind)27 local_scatter_WRAPPER(int n, void *dst, int *sv, void *src, __INT_T kind)
28 {
29
30 __fort_local_scatter[kind](n, dst, sv, src);
31 }
32
33 static void
local_scatter_INT1(int n,__INT1_T * dst,int * sv,__INT1_T * src)34 local_scatter_INT1(int n, __INT1_T *dst, int *sv, __INT1_T *src)
35 {
36 int i;
37 for (i = 0; i < n; ++i)
38 dst[sv[i]] = src[i];
39 }
40
41 static void
local_scatter_INT2(int n,__INT2_T * dst,int * sv,__INT2_T * src)42 local_scatter_INT2(int n, __INT2_T *dst, int *sv, __INT2_T *src)
43 {
44 int i;
45 for (i = 0; i < n; ++i)
46 dst[sv[i]] = src[i];
47 }
48
49 static void
local_scatter_INT4(int n,__INT4_T * dst,int * sv,__INT4_T * src)50 local_scatter_INT4(int n, __INT4_T *dst, int *sv, __INT4_T *src)
51 {
52 int i;
53 for (i = 0; i < n; ++i)
54 dst[sv[i]] = src[i];
55 }
56
57 static void
local_scatter_INT8(int n,__INT8_T * dst,int * sv,__INT8_T * src)58 local_scatter_INT8(int n, __INT8_T *dst, int *sv, __INT8_T *src)
59 {
60 int i;
61 for (i = 0; i < n; ++i)
62 dst[sv[i]] = src[i];
63 }
64
65 static void
local_scatter_LOG1(int n,__LOG1_T * dst,int * sv,__LOG1_T * src)66 local_scatter_LOG1(int n, __LOG1_T *dst, int *sv, __LOG1_T *src)
67 {
68 int i;
69 for (i = 0; i < n; ++i)
70 dst[sv[i]] = src[i];
71 }
72
73 static void
local_scatter_LOG2(int n,__LOG2_T * dst,int * sv,__LOG2_T * src)74 local_scatter_LOG2(int n, __LOG2_T *dst, int *sv, __LOG2_T *src)
75 {
76 int i;
77 for (i = 0; i < n; ++i)
78 dst[sv[i]] = src[i];
79 }
80
81 static void
local_scatter_LOG4(int n,__LOG4_T * dst,int * sv,__LOG4_T * src)82 local_scatter_LOG4(int n, __LOG4_T *dst, int *sv, __LOG4_T *src)
83 {
84 int i;
85 for (i = 0; i < n; ++i)
86 dst[sv[i]] = src[i];
87 }
88
89 static void
local_scatter_LOG8(int n,__LOG8_T * dst,int * sv,__LOG8_T * src)90 local_scatter_LOG8(int n, __LOG8_T *dst, int *sv, __LOG8_T *src)
91 {
92 int i;
93 for (i = 0; i < n; ++i)
94 dst[sv[i]] = src[i];
95 }
96
97 static void
local_scatter_REAL4(int n,__REAL4_T * dst,int * sv,__REAL4_T * src)98 local_scatter_REAL4(int n, __REAL4_T *dst, int *sv, __REAL4_T *src)
99 {
100 int i;
101 for (i = 0; i < n; ++i)
102 dst[sv[i]] = src[i];
103 }
104
105 static void
local_scatter_REAL8(int n,__REAL8_T * dst,int * sv,__REAL8_T * src)106 local_scatter_REAL8(int n, __REAL8_T *dst, int *sv, __REAL8_T *src)
107 {
108 int i;
109 for (i = 0; i < n; ++i)
110 dst[sv[i]] = src[i];
111 }
112
113 static void
local_scatter_REAL16(int n,__REAL16_T * dst,int * sv,__REAL16_T * src)114 local_scatter_REAL16(int n, __REAL16_T *dst, int *sv, __REAL16_T *src)
115 {
116 int i;
117 for (i = 0; i < n; ++i)
118 dst[sv[i]] = src[i];
119 }
120
121 static void
local_scatter_CPLX8(int n,__CPLX8_T * dst,int * sv,__CPLX8_T * src)122 local_scatter_CPLX8(int n, __CPLX8_T *dst, int *sv, __CPLX8_T *src)
123 {
124 int i;
125 for (i = 0; i < n; ++i)
126 dst[sv[i]] = src[i];
127 }
128
129 static void
local_scatter_CPLX16(int n,__CPLX16_T * dst,int * sv,__CPLX16_T * src)130 local_scatter_CPLX16(int n, __CPLX16_T *dst, int *sv, __CPLX16_T *src)
131 {
132 int i;
133 for (i = 0; i < n; ++i)
134 dst[sv[i]] = src[i];
135 }
136
137 static void
local_scatter_CPLX32(int n,__CPLX32_T * dst,int * sv,__CPLX32_T * src)138 local_scatter_CPLX32(int n, __CPLX32_T *dst, int *sv, __CPLX32_T *src)
139 {
140 int i;
141 for (i = 0; i < n; ++i)
142 dst[sv[i]] = src[i];
143 }
144
145 void (*__fort_local_scatter[__NTYPES])() = {
146 NULL, /* no type (absent optional argument) */
147 NULL, /* C signed short */
148 NULL, /* C unsigned short */
149 NULL, /* C signed int */
150 NULL, /* C unsigned int */
151 NULL, /* C signed long int */
152 NULL, /* C unsigned long int */
153 NULL, /* C float */
154 NULL, /* C double */
155 local_scatter_CPLX8, /* F complex*8 (2x real*4) */
156 local_scatter_CPLX16, /* F complex*16 (2x real*8) */
157 NULL, /* C signed char */
158 NULL, /* C unsigned char */
159 NULL, /* C long double */
160 NULL, /* F character */
161 NULL, /* C long long */
162 NULL, /* C unsigned long long */
163 local_scatter_LOG1, /* F logical*1 */
164 local_scatter_LOG2, /* F logical*2 */
165 local_scatter_LOG4, /* F logical*4 */
166 local_scatter_LOG8, /* F logical*8 */
167 NULL, /* F typeless */
168 NULL, /* F double typeless */
169 NULL, /* F ncharacter - kanji */
170 local_scatter_INT2, /* F integer*2 */
171 local_scatter_INT4, /* F integer*4, integer */
172 local_scatter_INT8, /* F integer*8 */
173 local_scatter_REAL4, /* F real*4, real */
174 local_scatter_REAL8, /* F real*8, double precision */
175 local_scatter_REAL16, /* F real*16 */
176 local_scatter_CPLX32, /* F complex*32 (2x real*16) */
177 NULL, /* F quad typeless */
178 local_scatter_INT1, /* F integer*1 */
179 NULL /* F derived type */
180 };
181
182 /* local gather-scatter functions */
183
184 void
local_gathscat_WRAPPER(int n,void * dst,int * sv,void * src,int * gv,__INT_T kind)185 local_gathscat_WRAPPER(int n, void *dst, int *sv, void *src, int *gv,
186 __INT_T kind)
187 {
188
189 __fort_local_gathscat[kind](n, dst, sv, src, gv);
190 }
191
192 static void
local_gathscat_INT1(int n,__INT1_T * dst,int * sv,__INT1_T * src,int * gv)193 local_gathscat_INT1(int n, __INT1_T *dst, int *sv, __INT1_T *src, int *gv)
194 {
195 int i;
196 for (i = 0; i < n; ++i)
197 dst[sv[i]] = src[gv[i]];
198 }
199
200 static void
local_gathscat_INT2(int n,__INT2_T * dst,int * sv,__INT2_T * src,int * gv)201 local_gathscat_INT2(int n, __INT2_T *dst, int *sv, __INT2_T *src, int *gv)
202 {
203 int i;
204 for (i = 0; i < n; ++i)
205 dst[sv[i]] = src[gv[i]];
206 }
207
208 static void
local_gathscat_INT4(int n,__INT4_T * dst,int * sv,__INT4_T * src,int * gv)209 local_gathscat_INT4(int n, __INT4_T *dst, int *sv, __INT4_T *src, int *gv)
210 {
211 int i;
212 for (i = 0; i < n; ++i)
213 dst[sv[i]] = src[gv[i]];
214 }
215
216 static void
local_gathscat_INT8(int n,__INT8_T * dst,int * sv,__INT8_T * src,int * gv)217 local_gathscat_INT8(int n, __INT8_T *dst, int *sv, __INT8_T *src, int *gv)
218 {
219 int i;
220 for (i = 0; i < n; ++i)
221 dst[sv[i]] = src[gv[i]];
222 }
223
224 static void
local_gathscat_LOG1(int n,__LOG1_T * dst,int * sv,__LOG1_T * src,int * gv)225 local_gathscat_LOG1(int n, __LOG1_T *dst, int *sv, __LOG1_T *src, int *gv)
226 {
227 int i;
228 for (i = 0; i < n; ++i)
229 dst[sv[i]] = src[gv[i]];
230 }
231
232 static void
local_gathscat_LOG2(int n,__LOG2_T * dst,int * sv,__LOG2_T * src,int * gv)233 local_gathscat_LOG2(int n, __LOG2_T *dst, int *sv, __LOG2_T *src, int *gv)
234 {
235 int i;
236 for (i = 0; i < n; ++i)
237 dst[sv[i]] = src[gv[i]];
238 }
239
240 static void
local_gathscat_LOG4(int n,__LOG4_T * dst,int * sv,__LOG4_T * src,int * gv)241 local_gathscat_LOG4(int n, __LOG4_T *dst, int *sv, __LOG4_T *src, int *gv)
242 {
243 int i;
244 for (i = 0; i < n; ++i)
245 dst[sv[i]] = src[gv[i]];
246 }
247
248 static void
local_gathscat_LOG8(int n,__LOG8_T * dst,int * sv,__LOG8_T * src,int * gv)249 local_gathscat_LOG8(int n, __LOG8_T *dst, int *sv, __LOG8_T *src, int *gv)
250 {
251 int i;
252 for (i = 0; i < n; ++i)
253 dst[sv[i]] = src[gv[i]];
254 }
255
256 static void
local_gathscat_REAL4(int n,__REAL4_T * dst,int * sv,__REAL4_T * src,int * gv)257 local_gathscat_REAL4(int n, __REAL4_T *dst, int *sv, __REAL4_T *src, int *gv)
258 {
259 int i;
260 for (i = 0; i < n; ++i)
261 dst[sv[i]] = src[gv[i]];
262 }
263
264 static void
local_gathscat_REAL8(int n,__REAL8_T * dst,int * sv,__REAL8_T * src,int * gv)265 local_gathscat_REAL8(int n, __REAL8_T *dst, int *sv, __REAL8_T *src, int *gv)
266 {
267 int i;
268 for (i = 0; i < n; ++i)
269 dst[sv[i]] = src[gv[i]];
270 }
271
272 static void
local_gathscat_REAL16(int n,__REAL16_T * dst,int * sv,__REAL16_T * src,int * gv)273 local_gathscat_REAL16(int n, __REAL16_T *dst, int *sv, __REAL16_T *src, int *gv)
274 {
275 int i;
276 for (i = 0; i < n; ++i)
277 dst[sv[i]] = src[gv[i]];
278 }
279
280 static void
local_gathscat_CPLX8(int n,__CPLX8_T * dst,int * sv,__CPLX8_T * src,int * gv)281 local_gathscat_CPLX8(int n, __CPLX8_T *dst, int *sv, __CPLX8_T *src, int *gv)
282 {
283 int i;
284 for (i = 0; i < n; ++i)
285 dst[sv[i]] = src[gv[i]];
286 }
287
288 static void
local_gathscat_CPLX16(int n,__CPLX16_T * dst,int * sv,__CPLX16_T * src,int * gv)289 local_gathscat_CPLX16(int n, __CPLX16_T *dst, int *sv, __CPLX16_T *src, int *gv)
290 {
291 int i;
292 for (i = 0; i < n; ++i)
293 dst[sv[i]] = src[gv[i]];
294 }
295
296 static void
local_gathscat_CPLX32(int n,__CPLX32_T * dst,int * sv,__CPLX32_T * src,int * gv)297 local_gathscat_CPLX32(int n, __CPLX32_T *dst, int *sv, __CPLX32_T *src, int *gv)
298 {
299 int i;
300 for (i = 0; i < n; ++i)
301 dst[sv[i]] = src[gv[i]];
302 }
303
304 void (*__fort_local_gathscat[__NTYPES])() = {
305 NULL, /* no type (absent optional argument) */
306 NULL, /* C signed short */
307 NULL, /* C unsigned short */
308 NULL, /* C signed int */
309 NULL, /* C unsigned int */
310 NULL, /* C signed long int */
311 NULL, /* C unsigned long int */
312 NULL, /* C float */
313 NULL, /* C double */
314 local_gathscat_CPLX8, /* F complex*8 (2x real*4) */
315 local_gathscat_CPLX16, /* F complex*16 (2x real*8) */
316 NULL, /* C signed char */
317 NULL, /* C unsigned char */
318 NULL, /* C long double */
319 NULL, /* F character */
320 NULL, /* C long long */
321 NULL, /* C unsigned long long */
322 local_gathscat_LOG1, /* F logical*1 */
323 local_gathscat_LOG2, /* F logical*2 */
324 local_gathscat_LOG4, /* F logical*4 */
325 local_gathscat_LOG8, /* F logical*8 */
326 NULL, /* F typeless */
327 NULL, /* F double typeless */
328 NULL, /* F ncharacter - kanji */
329 local_gathscat_INT2, /* F integer*2 */
330 local_gathscat_INT4, /* F integer*4, integer */
331 local_gathscat_INT8, /* F integer*8 */
332 local_gathscat_REAL4, /* F real*4, real */
333 local_gathscat_REAL8, /* F real*8, double precision */
334 local_gathscat_REAL16, /* F real*16 */
335 local_gathscat_CPLX32, /* F complex*32 (2x real*16) */
336 NULL, /* F quad typeless */
337 local_gathscat_INT1, /* F integer*1 */
338 NULL /* F derived type */
339 };
340