1 /*
2 * Copyright (c) 1997-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 /* hpf i/o array handling routines */
19
20 #include "stdioInterf.h"
21 #include "fioMacros.h"
22 #include "descRW.h"
23
24 char *__fort_getgbuf(long len);
25
26 #include "fort_vars.h"
27 #ifdef DESC_I8
28 #define __fort_owner_i8(a, b) 0
29 #define __fort_next_owner_i8(a, b, c, d) -1
30 #else
31 #define __fort_owner(a, b) 0
32 #define __fort_next_owner(a, b, c, d) -1
33 #endif
34 #define __fortio_stat_bcst(a) (*(a))
35
I8(__io_read)36 static void I8(__io_read)(fio_parm *z)
37 {
38 DECL_HDR_PTRS(ac);
39 char *adr, *buf;
40 int i, ioproc, owner, pc[MAXDIMS], str;
41
42 ac = z->ac;
43 adr = I8(__fort_local_address)(z->ab, ac, z->index);
44 str = z->str;
45 #if defined(DEBUG)
46 if (__fort_test & DEBUG_HFIO) {
47 printf("%d __io_read index=", GET_DIST_LCPU);
48 I8(__fort_show_index)(F90_RANK_G(ac), z->index);
49 printf(" cnt=%d str=%d adr=%x\n", z->cnt, str, adr);
50 }
51 #endif
52 if (LOCAL_MODE) {
53 if (!z->stat)
54 z->stat = z->f90io_rw(F90_KIND_G(ac), z->cnt, z->str * F90_LEN_G(ac), adr,
55 F90_LEN_G(ac));
56 return;
57 }
58 ioproc = GET_DIST_IOPROC;
59 buf = __fort_getgbuf(z->cnt * F90_LEN_G(ac));
60 if (GET_DIST_LCPU == ioproc) {
61 if (adr == NULL) {
62 adr = buf;
63 str = 1;
64 }
65 if (!z->stat)
66 z->stat = z->f90io_rw(F90_KIND_G(ac), z->cnt, str * F90_LEN_G(ac), adr,
67 F90_LEN_G(ac));
68 owner = I8(__fort_owner)(ac, z->index);
69 for (i = z->repl.ndim; --i >= 0;)
70 pc[i] = 0;
71 while (owner >= 0) {
72 if (owner != GET_DIST_LCPU)
73 __fort_rsendl(owner, adr, z->cnt, str, F90_KIND_G(ac), F90_LEN_G(ac));
74 owner = I8(__fort_next_owner)(ac, &z->repl, pc, owner);
75 }
76 } else if (adr != NULL)
77 __fort_rrecvl(ioproc, adr, z->cnt, str, F90_KIND_G(ac), F90_LEN_G(ac));
78 }
79
I8(__io_write)80 static void I8(__io_write)(fio_parm *z)
81 {
82 DECL_HDR_PTRS(ac);
83 char *adr, *buf;
84 int ioproc, owner, str;
85
86 ac = z->ac;
87 adr = I8(__fort_local_address)(z->ab, ac, z->index);
88 str = z->str;
89 #if defined(DEBUG)
90 if (__fort_test & DEBUG_HFIO) {
91 printf("%d __io_write index=", GET_DIST_LCPU);
92 I8(__fort_show_index)(F90_RANK_G(ac), z->index);
93 printf(" cnt=%d str=%d adr=%x\n", z->cnt, str, adr);
94 }
95 #endif
96 if (!z->stat)
97 z->stat = z->f90io_rw(F90_KIND_G(ac), z->cnt, str * F90_LEN_G(ac), adr,
98 F90_LEN_G(ac));
99 }
100
I8(__fortio_main)101 int I8(__fortio_main)(char *ab, /* base address */
102 F90_Desc *ac, /* array descriptor */
103 int rw, /* 0 => read, 1 => write */
104 int (*f90io_rw)()) /* f90io function */
105 {
106 int ioproc, size_of_kind;
107 fio_parm z;
108
109 z.stat = 0;
110 if (F90_TAG_G(ac) != __DESC) { /* scalar */
111 dtype kind = TYPEKIND(ac);
112 #if defined(DEBUG)
113 if (kind == __STR || kind == __DERIVED)
114 __fort_abort("__fortio_main: character or derived type not handled");
115 #endif
116 ioproc = GET_DIST_IOPROC;
117 size_of_kind = GET_DIST_SIZE_OF(kind);
118 if (LOCAL_MODE || GET_DIST_LCPU == ioproc)
119 z.stat = f90io_rw(kind, 1, 1, ab, size_of_kind);
120 if (!rw && !LOCAL_MODE) /* if global read... */
121 __fort_rbcstl(ioproc, ab, 1, 1, kind, size_of_kind);
122 return __fortio_stat_bcst(&z.stat);
123 }
124 if (F90_GSIZE_G(ac) <= 0)
125 return 0; /* zero-size array */
126 z.ab = ab + DIST_SCOFF_G(ac) * F90_LEN_G(ac);
127 z.ac = ac;
128 z.f90io_rw = f90io_rw;
129 z.fio_rw = rw ? I8(__io_write) : I8(__io_read);
130 if (!rw && !LOCAL_MODE) /* if global read... */
131 I8(__fort_describe_replication)(ac, &z.repl);
132 if (F90_RANK_G(ac) > 0)
133 I8(__fortio_loop)(&z, F90_RANK_G(ac));
134 else {
135 z.cnt = 1;
136 z.str = 1;
137 z.fio_rw(&z);
138 }
139 return __fortio_stat_bcst(&z.stat);
140 }
141