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