c_code.c
References to this file elsewhere.
1 #ifndef MS_SUA_
2 # include <stdio.h>
3 #endif
4 #include <fcntl.h>
5 #ifndef O_CREAT
6 # define O_CREAT _O_CREAT
7 #endif
8 #ifndef O_WRONLY
9 # define O_WRONLY _O_WRONLY
10 #endif
11
12 #define STANDARD_ERROR 2
13
14 #define STANDARD_OUTPUT 1
15
16 #ifndef STUBMPI
17 # include "mpi.h"
18 #endif
19 #include "rsl_lite.h"
20
21 #define F_PACK
22
23 RSL_LITE_ERROR_DUP1 ( int *me )
24 {
25 int newfd ;
26 char filename[256] ;
27 char hostname[256] ;
28
29 #ifndef MS_SUA
30 gethostname( hostname, 256 ) ;
31
32 /* redirect standard out*/
33 sprintf(filename,"rsl.out.%04d",*me) ;
34 if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
35 {
36 perror("error_dup: cannot open rsl.out.nnnn") ;
37 fprintf(stderr,"...sending output to standard output and continuing.\n") ;
38 return ;
39 }
40 if( dup2( newfd, STANDARD_OUTPUT ) < 0 )
41 {
42 perror("error_dup: dup2 fails to change output descriptor") ;
43 fprintf(stderr,"...sending output to standard output and continuing.\n") ;
44 close(newfd) ;
45 return ;
46 }
47
48 /* redirect standard error */
49 sprintf(filename,"rsl.error.%04d",*me) ;
50 if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
51 {
52 perror("error_dup: cannot open rsl.error.log") ;
53 fprintf(stderr,"...sending error to standard error and continuing.\n") ;
54 return ;
55 }
56 if( dup2( newfd, STANDARD_ERROR ) < 0 )
57 {
58 perror("error_dup: dup2 fails to change error descriptor") ;
59 fprintf(stderr,"...sending error to standard error and continuing.\n") ;
60 close(newfd) ;
61 return ;
62 }
63 #if (DA_CORE != 1)
64 /* Do not want this in wrfvar output streams */
65 fprintf( stdout, "taskid: %d hostname: %s\n",*me,hostname) ;
66 fprintf( stderr, "taskid: %d hostname: %s\n",*me,hostname) ;
67 #endif
68 #else
69 printf("host %d", *me ) ;
70 system("hostname") ;
71 sprintf( hostname, "host %d", *me ) ;
72 /* redirect standard out*/
73 sprintf(filename,"rsl.out.%04d",*me) ;
74 if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
75 {
76 return ;
77 }
78 if( dup2( newfd, STANDARD_OUTPUT ) < 0 )
79 {
80 close(newfd) ;
81 return ;
82 }
83 /* redirect standard error */
84 sprintf(filename,"rsl.error.%04d",*me) ;
85 if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
86 {
87 return ;
88 }
89 if( dup2( newfd, STANDARD_ERROR ) < 0 )
90 {
91 close(newfd) ;
92 return ;
93 }
94
95 #endif
96
97 }
98
99 BYTE_BCAST ( char * buf, int * size, int * Fcomm )
100 {
101 #ifndef STUBMPI
102 MPI_Comm *comm, dummy_comm ;
103
104 comm = &dummy_comm ;
105 *comm = MPI_Comm_f2c( *Fcomm ) ;
106 # ifdef crayx1
107 if (*size % sizeof(int) == 0) {
108 MPI_Bcast ( buf, *size/sizeof(int), MPI_INT, 0, *comm ) ;
109 } else {
110 MPI_Bcast ( buf, *size, MPI_BYTE, 0, *comm ) ;
111 }
112 # else
113 MPI_Bcast ( buf, *size, MPI_BYTE, 0, *comm ) ;
114 # endif
115 #endif
116 }
117
118 static int yp_curs, ym_curs, xp_curs, xm_curs ;
119
120 RSL_LITE_INIT_EXCH (
121 int * Fcomm0,
122 int * shw0,
123 int * n3dR0, int *n2dR0, int * typesizeR0 ,
124 int * n3dI0, int *n2dI0, int * typesizeI0 ,
125 int * n3dD0, int *n2dD0, int * typesizeD0 ,
126 int * n3dL0, int *n2dL0, int * typesizeL0 ,
127 int * me0, int * np0 , int * np_x0 , int * np_y0 ,
128 int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
129 {
130 int n3dR, n2dR, typesizeR ;
131 int n3dI, n2dI, typesizeI ;
132 int n3dD, n2dD, typesizeD ;
133 int n3dL, n2dL, typesizeL ;
134 int shw ;
135 int me, np, np_x, np_y ;
136 int ips , ipe , jps , jpe , kps , kpe ;
137 int yp, ym, xp, xm ;
138 int nbytes ;
139
140 #ifndef STUBMPI
141 MPI_Comm comm, *comm0, dummy_comm ;
142
143 comm0 = &dummy_comm ;
144 *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
145
146 shw = *shw0 ;
147 n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
148 n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
149 n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
150 n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
151 me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
152 ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
153
154 if ( np_y > 1 ) {
155 nbytes = typesizeR*(ipe-ips+1+2*shw)*shw*(n3dR*(kpe-kps+1)+n2dR) +
156 typesizeI*(ipe-ips+1+2*shw)*shw*(n3dI*(kpe-kps+1)+n2dI) +
157 typesizeD*(ipe-ips+1+2*shw)*shw*(n3dD*(kpe-kps+1)+n2dD) +
158 typesizeL*(ipe-ips+1+2*shw)*shw*(n3dL*(kpe-kps+1)+n2dL) ;
159 MPI_Cart_shift ( *comm0, 0, 1, &ym, &yp ) ;
160 if ( yp != MPI_PROC_NULL ) {
161 buffer_for_proc ( yp , nbytes, RSL_RECVBUF ) ;
162 buffer_for_proc ( yp , nbytes, RSL_SENDBUF ) ;
163 }
164 if ( ym != MPI_PROC_NULL ) {
165 buffer_for_proc ( ym , nbytes, RSL_RECVBUF ) ;
166 buffer_for_proc ( ym , nbytes, RSL_SENDBUF ) ;
167 }
168 }
169 if ( np_x > 1 ) {
170 nbytes = typesizeR*(jpe-jps+1+2*shw)*shw*(n3dR*(kpe-kps+1)+n2dR) +
171 typesizeI*(jpe-jps+1+2*shw)*shw*(n3dI*(kpe-kps+1)+n2dI) +
172 typesizeD*(jpe-jps+1+2*shw)*shw*(n3dD*(kpe-kps+1)+n2dD) +
173 typesizeL*(jpe-jps+1+2*shw)*shw*(n3dL*(kpe-kps+1)+n2dL) ;
174 MPI_Cart_shift ( *comm0, 1, 1, &xm, &xp ) ;
175 if ( xp != MPI_PROC_NULL ) {
176 buffer_for_proc ( xp , nbytes, RSL_RECVBUF ) ;
177 buffer_for_proc ( xp , nbytes, RSL_SENDBUF ) ;
178 }
179 if ( xm != MPI_PROC_NULL ) {
180 buffer_for_proc ( xm , nbytes, RSL_RECVBUF ) ;
181 buffer_for_proc ( xm , nbytes, RSL_SENDBUF ) ;
182 }
183 }
184 #endif
185 yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
186 }
187
188 RSL_LITE_PACK ( int * Fcomm0, char * buf , int * shw0 , int * typesize0 , int * xy0 , int * pu0 , int * imemord , int * xstag0, /* not used */
189 int *me0, int * np0 , int * np_x0 , int * np_y0 ,
190 int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
191 int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
192 int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
193 {
194 int me, np, np_x, np_y ;
195 int shw , typesize ;
196 int ids , ide , jds , jde , kds , kde ;
197 int ims , ime , jms , jme , kms , kme ;
198 int ips , ipe , jps , jpe , kps , kpe ;
199 int xy ; /* y = 0 , x = 1 */
200 int pu ; /* pack = 0 , unpack = 1 */
201 register int i, j, k, t ;
202 #ifdef crayx1
203 register int i2,i3,i4,i_offset;
204 #endif
205 char *p ;
206 int da_buf ;
207 int yp, ym, xp, xm ;
208 int nbytes, ierr ;
209 register int *pi, *qi ;
210
211 #ifndef STUBMPI
212 MPI_Comm comm, *comm0, dummy_comm ;
213 int js, je, ks, ke, is, ie, wcount ;
214
215 comm0 = &dummy_comm ;
216 *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
217
218 me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
219 shw = *shw0 ; typesize = *typesize0 ;
220 ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
221 ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
222 ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
223 xy = *xy0 ;
224 pu = *pu0 ;
225
226 /* need to adapt for other memory orders */
227
228 #define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*((E3)-(S3)+1)*((E4)-(S4)+1))
229 #define IMAX(A) (((A)>ids)?(A):ids)
230 #define IMIN(A) (((A)<ide)?(A):ide)
231 #define JMAX(A) (((A)>jds)?(A):jds)
232 #define JMIN(A) (((A)<jde)?(A):jde)
233
234 da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
235
236 if ( np_y > 1 && xy == 0 ) {
237 MPI_Cart_shift( *comm0 , 0, 1, &ym, &yp ) ;
238 if ( yp != MPI_PROC_NULL ) {
239 p = buffer_for_proc( yp , 0 , da_buf ) ;
240 if ( pu == 0 ) {
241 js = jpe-shw+1 ; je = jpe ;
242 ks = kps ; ke = kpe ;
243 is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
244 nbytes = buffer_size_for_proc( yp, da_buf ) ;
245 if ( yp_curs + RANGE( jpe-shw+1, jpe, kps, kpe, ips-shw, ipe+shw, 1, typesize ) > nbytes ) {
246 #ifndef MS_SUA
247 fprintf(stderr,"memory overwrite in rsl_lite_pack, Y pack up, %d > %d\n",
248 yp_curs + RANGE( jpe-shw+1, jpe, kps, kpe, ips-shw, ipe+shw, 1, typesize ), nbytes ) ;
249 #endif
250 MPI_Abort(MPI_COMM_WORLD, 99) ;
251 }
252 if ( typesize == 8 ) {
253 F_PACK_LINT ( buf, p+yp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
254 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
255 yp_curs += wcount*typesize ;
256 }
257 else if ( typesize == 4 ) {
258 F_PACK_INT ( buf, p+yp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
259 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
260 yp_curs += wcount*typesize ;
261 }
262 else {
263 #ifndef MS_SUA
264 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
265 #endif
266 }
267 } else {
268 js = jpe+1 ; je = jpe+shw ;
269 ks = kps ; ke = kpe ;
270 is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
271 if ( typesize == 8 ) {
272 F_UNPACK_LINT ( p+yp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
273 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
274 yp_curs += wcount*typesize ;
275 }
276 else if ( typesize == 4 ) {
277 F_UNPACK_INT ( p+yp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
278 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
279 yp_curs += wcount*typesize ;
280 }
281 else {
282 #ifndef MS_SUA
283 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
284 #endif
285 }
286 }
287 }
288 if ( ym != MPI_PROC_NULL ) {
289 p = buffer_for_proc( ym , 0 , da_buf ) ;
290 if ( pu == 0 ) {
291 js = jps ; je = jps+shw-1 ;
292 ks = kps ; ke = kpe ;
293 is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
294 nbytes = buffer_size_for_proc( ym, da_buf ) ;
295 if ( ym_curs + RANGE( jps, jps+shw-1, kps, kpe, ips-shw, ipe+shw, 1, typesize ) > nbytes ) {
296 #ifndef MS_SUA
297 fprintf(stderr,"memory overwrite in rsl_lite_pack, Y pack dn, %d > %d\n",
298 ym_curs + RANGE( jps, jps+shw-1, kps, kpe, ips-shw, ipe+shw, 1, typesize ), nbytes ) ;
299 #endif
300 MPI_Abort(MPI_COMM_WORLD, 99) ;
301 }
302 if ( typesize == 8 ) {
303 F_PACK_LINT ( buf, p+ym_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
304 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
305 ym_curs += wcount*typesize ;
306 }
307 else if ( typesize == 4 ) {
308 F_PACK_INT ( buf, p+ym_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
309 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
310 ym_curs += wcount*typesize ;
311 }
312 else {
313 #ifndef MS_SUA
314 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
315 #endif
316 }
317 } else {
318 js = jps-shw ; je = jps-1 ;
319 ks = kps ; ke = kpe ;
320 is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
321 if ( typesize == 8 ) {
322 F_UNPACK_LINT ( p+ym_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
323 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
324 ym_curs += wcount*typesize ;
325 }
326 else if ( typesize == 4 ) {
327 F_UNPACK_INT ( p+ym_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
328 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
329 ym_curs += wcount*typesize ;
330 }
331 else {
332 #ifndef MS_SUA
333 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
334 #endif
335 }
336 }
337 }
338 }
339
340 if ( np_x > 1 && xy == 1 ) {
341 MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
342 if ( xp != MPI_PROC_NULL ) {
343 p = buffer_for_proc( xp , 0 , da_buf ) ;
344 if ( pu == 0 ) {
345 js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
346 ks = kps ; ke = kpe ;
347 is = ipe-shw+1 ; ie = ipe ;
348 nbytes = buffer_size_for_proc( xp, da_buf ) ;
349 if ( xp_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ipe-shw+1, ipe, 1, typesize ) > nbytes ) {
350 #ifndef MS_SUA
351 fprintf(stderr,"memory overwrite in rsl_lite_pack, X pack right, %d > %d\n",
352 xp_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ipe-shw+1, ipe, 1, typesize ), nbytes ) ;
353 #endif
354 MPI_Abort(MPI_COMM_WORLD, 99) ;
355 }
356 if ( typesize == 8 ) {
357 F_PACK_LINT ( buf, p+xp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
358 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
359 xp_curs += wcount*typesize ;
360 }
361 else if ( typesize == 4 ) {
362 F_PACK_INT ( buf, p+xp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
363 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
364 xp_curs += wcount*typesize ;
365 }
366 else {
367 #ifndef MS_SUA
368 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
369 #endif
370 }
371 } else {
372 js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
373 ks = kps ; ke = kpe ;
374 is = ipe+1 ; ie = ipe+shw ;
375 if ( typesize == 8 ) {
376 F_UNPACK_LINT ( p+xp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
377 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
378 xp_curs += wcount*typesize ;
379 }
380 else if ( typesize == 4 ) {
381 F_UNPACK_INT ( p+xp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
382 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
383 xp_curs += wcount*typesize ;
384 }
385 else {
386 #ifndef MS_SUA
387 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
388 #endif
389 }
390 }
391 }
392 if ( xm != MPI_PROC_NULL ) {
393 p = buffer_for_proc( xm , 0 , da_buf ) ;
394 if ( pu == 0 ) {
395 js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
396 ks = kps ; ke = kpe ;
397 is = ips ; ie = ips+shw-1 ;
398 nbytes = buffer_size_for_proc( xm, da_buf ) ;
399 if ( xm_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ips, ips+shw-1, 1, typesize ) > nbytes ) {
400 #ifndef MS_SUA
401 fprintf(stderr,"memory overwrite in rsl_lite_pack, X left , %d > %d\n",
402 xm_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ips, ips+shw-1, 1, typesize ), nbytes ) ;
403 #endif
404 MPI_Abort(MPI_COMM_WORLD, 99) ;
405 }
406 if ( typesize == 8 ) {
407 F_PACK_LINT ( buf, p+xm_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
408 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
409 xm_curs += wcount*typesize ;
410 }
411 else if ( typesize == 4 ) {
412 F_PACK_INT ( buf, p+xm_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
413 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
414 xm_curs += wcount*typesize ;
415 }
416 else {
417 #ifndef MS_SUA
418 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
419 #endif
420 }
421 } else {
422 js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
423 ks = kps ; ke = kpe ;
424 is = ips-shw ; ie = ips-1 ;
425 if ( typesize == 8 ) {
426 F_UNPACK_LINT ( p+xm_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
427 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
428 xm_curs += wcount*typesize ;
429 }
430 else if ( typesize == 4 ) {
431 F_UNPACK_INT ( p+xm_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
432 &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
433 xm_curs += wcount*typesize ;
434 }
435 else {
436 #ifndef MS_SUA
437 fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
438 #endif
439 }
440 }
441 }
442 }
443 #endif
444
445 }
446
447 #ifndef STUBMPI
448 static MPI_Request yp_recv, ym_recv, yp_send, ym_send ;
449 static MPI_Request xp_recv, xm_recv, xp_send, xm_send ;
450 #endif
451
452 RSL_LITE_EXCH_Y ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
453 {
454 int me, np, np_x, np_y ;
455 int yp, ym, xp, xm, ierr ;
456 #ifndef STUBMPI
457 MPI_Status stat ;
458 MPI_Comm comm, *comm0, dummy_comm ;
459
460 comm0 = &dummy_comm ;
461 *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
462 comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
463 if ( np_y > 1 ) {
464 MPI_Cart_shift( *comm0, 0, 1, &ym, &yp ) ;
465 if ( yp != MPI_PROC_NULL ) {
466 ierr=MPI_Irecv ( buffer_for_proc( yp, yp_curs, RSL_RECVBUF ), yp_curs, MPI_CHAR, yp, me, comm, &yp_recv ) ;
467 }
468 if ( ym != MPI_PROC_NULL ) {
469 ierr=MPI_Irecv ( buffer_for_proc( ym, ym_curs, RSL_RECVBUF ), ym_curs, MPI_CHAR, ym, me, comm, &ym_recv ) ;
470 }
471 if ( yp != MPI_PROC_NULL ) {
472 ierr=MPI_Isend ( buffer_for_proc( yp, 0, RSL_SENDBUF ), yp_curs, MPI_CHAR, yp, yp, comm, &yp_send ) ;
473 }
474 if ( ym != MPI_PROC_NULL ) {
475 ierr=MPI_Isend ( buffer_for_proc( ym, 0, RSL_SENDBUF ), ym_curs, MPI_CHAR, ym, ym, comm, &ym_send ) ;
476 }
477 if ( yp != MPI_PROC_NULL ) MPI_Wait( &yp_recv, &stat ) ;
478 if ( ym != MPI_PROC_NULL ) MPI_Wait( &ym_recv, &stat ) ;
479 if ( yp != MPI_PROC_NULL ) MPI_Wait( &yp_send, &stat ) ;
480 if ( ym != MPI_PROC_NULL ) MPI_Wait( &ym_send, &stat ) ;
481 }
482 yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
483 #endif
484 }
485
486 RSL_LITE_EXCH_X ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
487 {
488 int me, np, np_x, np_y ;
489 int yp, ym, xp, xm ;
490 #ifndef STUBMPI
491 MPI_Status stat ;
492 MPI_Comm comm, *comm0, dummy_comm ;
493
494 comm0 = &dummy_comm ;
495 *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
496 comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
497 if ( np_x > 1 ) {
498 MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
499 if ( xp != MPI_PROC_NULL ) {
500 MPI_Irecv ( buffer_for_proc( xp, xp_curs, RSL_RECVBUF ), xp_curs, MPI_CHAR, xp, me, comm, &xp_recv ) ;
501 }
502 if ( xm != MPI_PROC_NULL ) {
503 MPI_Irecv ( buffer_for_proc( xm, xm_curs, RSL_RECVBUF ), xm_curs, MPI_CHAR, xm, me, comm, &xm_recv ) ;
504 }
505 if ( xp != MPI_PROC_NULL ) {
506 MPI_Isend ( buffer_for_proc( xp, 0, RSL_SENDBUF ), xp_curs, MPI_CHAR, xp, xp, comm, &xp_send ) ;
507 }
508 if ( xm != MPI_PROC_NULL ) {
509 MPI_Isend ( buffer_for_proc( xm, 0, RSL_SENDBUF ), xm_curs, MPI_CHAR, xm, xm, comm, &xm_send ) ;
510 }
511 if ( xp != MPI_PROC_NULL ) MPI_Wait( &xp_recv, &stat ) ;
512 if ( xm != MPI_PROC_NULL ) MPI_Wait( &xm_recv, &stat ) ;
513 if ( xp != MPI_PROC_NULL ) MPI_Wait( &xp_send, &stat ) ;
514 if ( xm != MPI_PROC_NULL ) MPI_Wait( &xm_send, &stat ) ;
515 }
516 yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
517 #endif
518 }
519
520 #ifndef MS_SUA
521 #include <sys/time.h>
522 RSL_INTERNAL_MILLICLOCK ()
523 {
524 struct timeval tb ;
525 struct timezone tzp ;
526 int isec ; /* seconds */
527 int usec ; /* microseconds */
528 int msecs ;
529 gettimeofday( &tb, &tzp ) ;
530 isec = tb.tv_sec ;
531 usec = tb.tv_usec ;
532 msecs = 1000 * isec + usec / 1000 ;
533 return(msecs) ;
534 }
535 RSL_INTERNAL_MICROCLOCK ()
536 {
537 struct timeval tb ;
538 struct timezone tzp ;
539 int isec ; /* seconds */
540 int usec ; /* microseconds */
541 int msecs ;
542 gettimeofday( &tb, &tzp ) ;
543 isec = tb.tv_sec ;
544 usec = tb.tv_usec ;
545 msecs = 1000000 * isec + usec ;
546 return(msecs) ;
547 }
548 #endif