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