collect_on_comm.c
References to this file elsewhere.
1 #ifndef MS_SUA
2 # include <stdio.h>
3 # include <stdlib.h>
4 #endif
5 #if defined( DM_PARALLEL ) && ! defined( STUBMPI )
6 # include <mpi.h>
7 #endif
8
9 #ifndef CRAY
10 # ifdef NOUNDERSCORE
11 # define COLLECT_ON_COMM collect_on_comm
12 # define COLLECT_ON_COMM0 collect_on_comm0
13 # define DIST_ON_COMM dist_on_comm
14 # define DIST_ON_COMM0 dist_on_comm0
15 # define INT_PACK_DATA int_pack_data
16 # define INT_GET_TI_HEADER_C int_get_ti_header_c
17 # define INT_GEN_TI_HEADER_C int_gen_ti_header_c
18 # else
19 # ifdef F2CSTYLE
20 # define COLLECT_ON_COMM collect_on_comm__
21 # define COLLECT_ON_COMM0 collect_on_comm0__
22 # define DIST_ON_COMM dist_on_comm__
23 # define DIST_ON_COMM0 dist_on_comm0__
24 # define INT_PACK_DATA int_pack_data__
25 # define INT_GET_TI_HEADER_C int_get_ti_header_c__
26 # define INT_GEN_TI_HEADER_C int_gen_ti_header_c__
27 # else
28 # define COLLECT_ON_COMM collect_on_comm_
29 # define COLLECT_ON_COMM0 collect_on_comm0_
30 # define DIST_ON_COMM dist_on_comm_
31 # define DIST_ON_COMM0 dist_on_comm0_
32 # define INT_PACK_DATA int_pack_data_
33 # define INT_GET_TI_HEADER_C int_get_ti_header_c_
34 # define INT_GEN_TI_HEADER_C int_gen_ti_header_c_
35 # endif
36 # endif
37 #endif
38
39 COLLECT_ON_COMM ( int * comm, int * typesize ,
40 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
41 {
42 col_on_comm ( comm, typesize ,
43 inbuf, ninbuf , outbuf, noutbuf, 1 ) ;
44 }
45
46 /* collect on node 0*/
47 COLLECT_ON_COMM0 ( int * comm, int * typesize ,
48 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
49 {
50 col_on_comm ( comm, typesize ,
51 inbuf, ninbuf , outbuf, noutbuf, 0 ) ;
52 }
53
54 int
55 col_on_comm ( int * Fcomm, int * typesize ,
56 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw )
57 {
58 #if defined( DM_PARALLEL ) && ! defined(STUBMPI)
59 int mytask, ntasks, p ;
60 int *recvcounts ;
61 int *displace ;
62 int noutbuf_loc ;
63 int root_task ;
64 MPI_Comm *comm, dummy_comm ;
65 int ierr ;
66
67 comm = &dummy_comm ;
68 *comm = MPI_Comm_f2c( *Fcomm ) ;
69 MPI_Comm_size ( *comm, &ntasks ) ;
70 MPI_Comm_rank ( *comm, &mytask ) ;
71 recvcounts = (int *) malloc( ntasks * sizeof(int)) ;
72 displace = (int *) malloc( ntasks * sizeof(int)) ;
73 root_task = ( sw == 0 ) ? 0 : ntasks-1 ;
74
75 /* collect up recvcounts */
76 ierr = MPI_Gather( ninbuf , 1 , MPI_INT , recvcounts , 1 , MPI_INT , root_task , *comm ) ;
77 #ifndef MS_SUA
78 if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gather returns %d\n",__FILE__,__LINE__,ierr ) ;
79 #endif
80
81 if ( mytask == root_task ) {
82
83 /* figure out displacements */
84 for ( p = 1 , displace[0] = 0 , noutbuf_loc = recvcounts[0] ; p < ntasks ; p++ ) {
85 displace[p] = displace[p-1]+recvcounts[p-1] ;
86 noutbuf_loc = noutbuf_loc + recvcounts[p] ;
87 }
88
89 if ( noutbuf_loc > * noutbuf )
90 {
91 #ifndef MS_SUA
92 fprintf(stderr,"FATAL ERROR: collect_on_comm: noutbuf_loc (%d) > noutbuf (%d)\n",
93 noutbuf_loc , * noutbuf ) ;
94 fprintf(stderr,"WILL NOT perform the collection operation\n") ;
95 #endif
96 MPI_Abort(MPI_COMM_WORLD,1) ;
97 }
98
99 /* multiply everything by the size of the type */
100 for ( p = 0 ; p < ntasks ; p++ ) {
101 displace[p] *= *typesize ;
102 recvcounts[p] *= *typesize ;
103 }
104 }
105
106 ierr = MPI_Gatherv( inbuf , *ninbuf * *typesize , MPI_CHAR ,
107 outbuf , recvcounts , displace, MPI_CHAR ,
108 root_task , *comm ) ;
109 #ifndef MS_SUA
110 if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gatherv returns %d\n",__FILE__,__LINE__,ierr ) ;
111 #endif
112
113 free(recvcounts) ;
114 free(displace) ;
115 #endif
116 return(0) ;
117 }
118
119
120 DIST_ON_COMM ( int * comm, int * typesize ,
121 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
122 {
123 dst_on_comm ( comm, typesize ,
124 inbuf, ninbuf , outbuf, noutbuf, 1 ) ;
125 }
126
127 DIST_ON_COMM0 ( int * comm, int * typesize ,
128 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
129 {
130 dst_on_comm ( comm, typesize ,
131 inbuf, ninbuf , outbuf, noutbuf, 0 ) ;
132 }
133
134 dst_on_comm ( int * Fcomm, int * typesize ,
135 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw )
136 {
137 #if defined(DM_PARALLEL) && ! defined(STUBMPI)
138 int mytask, ntasks, p ;
139 int *sendcounts ;
140 int *displace ;
141 int noutbuf_loc ;
142 int root_task ;
143 MPI_Comm *comm, dummy_comm ;
144
145 comm = &dummy_comm ;
146 *comm = MPI_Comm_f2c( *Fcomm ) ;
147 MPI_Comm_size ( *comm, &ntasks ) ;
148 MPI_Comm_rank ( *comm, &mytask ) ;
149 sendcounts = (int *) malloc( ntasks * sizeof(int)) ;
150 displace = (int *) malloc( ntasks * sizeof(int)) ;
151 root_task = ( sw == 0 ) ? 0 : ntasks-1 ;
152
153 /* collect up sendcounts */
154 MPI_Gather( noutbuf , 1 , MPI_INT , sendcounts , 1 , MPI_INT , root_task , *comm ) ;
155
156 if ( mytask == root_task ) {
157
158 /* figure out displacements */
159 for ( p = 1 , displace[0] = 0 , noutbuf_loc = sendcounts[0] ; p < ntasks ; p++ ) {
160 displace[p] = displace[p-1]+sendcounts[p-1] ;
161 noutbuf_loc = noutbuf_loc + sendcounts[p] ;
162 }
163
164 /* multiply everything by the size of the type */
165 for ( p = 0 ; p < ntasks ; p++ ) {
166 displace[p] *= *typesize ;
167 sendcounts[p] *= *typesize ;
168 }
169 }
170
171 MPI_Scatterv( inbuf , sendcounts , displace, MPI_CHAR ,
172 outbuf , *noutbuf * *typesize , MPI_CHAR ,
173 root_task , *comm ) ;
174
175 free(sendcounts) ;
176 free(displace) ;
177 #endif
178 return(0) ;
179 }
180
181 #ifndef MS_SUA
182 #ifndef MACOS
183 # include <malloc.h>
184 # include <sys/resource.h>
185 #endif
186
187 #if 0
188 int getrusage(
189 int who,
190 struct rusage *r_usage);
191 #endif
192
193 #if 0
194 extern int outy ;
195 extern int maxstug, nouty, maxouty ;
196 #endif
197
198 #if 0
199 #include <unistd.h>
200 #include <sys/times.h>
201 /* used internally for chasing memory leaks on ibm */
202 rlim_ ()
203 {
204 #ifndef MACOS
205
206 struct rusage r_usage ;
207 struct mallinfo minf ;
208 struct tms tm ;
209 long tick, tock ;
210
211 tick = sysconf( _SC_CLK_TCK ) ;
212 times( &tm ) ;
213 tock = (tm.tms_utime + tm.tms_stime)*tick ;
214
215 getrusage ( RUSAGE_SELF, &r_usage ) ;
216 if ( tock != 0 ) {
217 #ifndef MS_SUA
218 fprintf(stderr,"sm %ld d %ld s %ld maxrss %ld %d %d %ld\n",r_usage.ru_ixrss/tock,r_usage.ru_idrss/tock,r_usage.ru_isrss/tock, r_usage.ru_maxrss,tick,tock,r_usage.ru_ixrss) ;
219 #endif
220 }
221 minf = mallinfo() ;
222 #ifndef MS_SUAL
223 fprintf(stderr,"a %ld usm %ld fsm %ld uord %ld ford %ld hblkhd %d\n",minf.arena,minf.usmblks,minf.fsmblks,minf.uordblks,minf.fordblks,minf.hblkhd) ;
224 #endif
225 # if 0
226 fprintf(stderr," outy %d nouty %d maxstug %d maxouty %d \n", outy, nouty, maxstug, maxouty ) ;
227 # endif
228 #endif
229 }
230 #endif
231 #endif
232