source: trunk/WRF.COMMON/WRFV3/external/RSL_LITE/period.c @ 3532

Last change on this file since 3532 was 2759, checked in by aslmd, 3 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
  • Property svn:executable set to *
File size: 17.8 KB
RevLine 
[2759]1#ifndef MS_SUA
2# include <stdio.h>
3#endif
4#include <fcntl.h>
5
6#define STANDARD_ERROR 2
7
8#define STANDARD_OUTPUT 1
9
10#ifndef STUBMPI
11# include "mpi.h"
12#endif
13#include "rsl_lite.h"
14
15static int yp_curs, ym_curs, xp_curs, xm_curs ;
16
17RSL_LITE_INIT_PERIOD ( 
18                int * Fcomm0,
19                int * shw0,
20                int * n3dR0, int *n2dR0, int * typesizeR0 , 
21                int * n3dI0, int *n2dI0, int * typesizeI0 , 
22                int * n3dD0, int *n2dD0, int * typesizeD0 , 
23                int * n3dL0, int *n2dL0, int * typesizeL0 , 
24                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
25                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
26{
27#ifndef STUBMPI
28  int n3dR, n2dR, typesizeR ;
29  int n3dI, n2dI, typesizeI ;
30  int n3dD, n2dD, typesizeD ;
31  int n3dL, n2dL, typesizeL ;
32  int shw ;
33  int me, np, np_x, np_y ;
34  int ips , ipe , jps , jpe , kps , kpe ;
35  int yp, ym, xp, xm ;
36  int nbytes ;
37  int coords[2] ;
38  MPI_Comm comm, *comm0, dummy_comm ;
39
40  comm0 = &dummy_comm ;
41  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
42
43  shw = *shw0 ;
44  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
45  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
46  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
47  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
48  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
49  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
50
51/*
52 This assumes that the topoology associated with the communicator is periodic
53 the period routines should be called with "local_communicator_periodic", which
54 is set up in module_dm.F for RSL_LITE.  Registry generated code automatically
55 does this (gen_comms.c for RSL_LITE).
56*/
57  if ( np_y > 1 ) {
58    nbytes = typesizeR*(ipe-ips+1+2*shw)*(shw+1)*(n3dR*(kpe-kps+1)+n2dR) +
59             typesizeI*(ipe-ips+1+2*shw)*(shw+1)*(n3dI*(kpe-kps+1)+n2dI) +
60             typesizeD*(ipe-ips+1+2*shw)*(shw+1)*(n3dD*(kpe-kps+1)+n2dD) +
61             typesizeL*(ipe-ips+1+2*shw)*(shw+1)*(n3dL*(kpe-kps+1)+n2dL) ;
62    MPI_Comm_rank( *comm0, &me ) ;
63    MPI_Cart_coords( *comm0, me, 2, coords ) ;
64    MPI_Cart_shift( *comm0, 0, 1, &ym, &yp ) ;
65    if ( yp != MPI_PROC_NULL && coords[0] == np_y - 1 ) {  /* process on top of mesh */
66       buffer_for_proc ( yp , nbytes, RSL_RECVBUF ) ;
67       buffer_for_proc ( yp , nbytes, RSL_SENDBUF ) ;
68    }
69    if ( ym != MPI_PROC_NULL && coords[0] == 0 ) {         /* process on bottom of mesh */
70       buffer_for_proc ( ym , nbytes, RSL_RECVBUF ) ;
71       buffer_for_proc ( ym , nbytes, RSL_SENDBUF ) ;
72    }
73  }
74  if ( np_x > 1 ) {
75    nbytes = typesizeR*(jpe-jps+1+2*shw)*(shw+1)*(n3dR*(kpe-kps+1)+n2dR) +
76             typesizeI*(jpe-jps+1+2*shw)*(shw+1)*(n3dI*(kpe-kps+1)+n2dI) +
77             typesizeD*(jpe-jps+1+2*shw)*(shw+1)*(n3dD*(kpe-kps+1)+n2dD) +
78             typesizeL*(jpe-jps+1+2*shw)*(shw+1)*(n3dL*(kpe-kps+1)+n2dL) ;
79    MPI_Comm_rank( *comm0, &me ) ;
80    MPI_Cart_coords( *comm0, me, 2, coords ) ;
81    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
82    if ( xm != MPI_PROC_NULL && coords[1] == np_x - 1 ) { /* process on right hand side of mesh */
83       buffer_for_proc ( xp , nbytes, RSL_RECVBUF ) ;
84       buffer_for_proc ( xp , nbytes, RSL_SENDBUF ) ;
85    }
86    if ( xp != MPI_PROC_NULL && coords[1] == 0 ) {        /* process on left hand side of mesh */
87       buffer_for_proc ( xm,  nbytes, RSL_RECVBUF ) ;
88       buffer_for_proc ( xm , nbytes, RSL_SENDBUF ) ;
89    }
90  }
91  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
92#endif
93}
94
95
96RSL_LITE_PACK_PERIOD ( int* Fcomm0, char * buf , int * shw0 , int * typesize0 , int * xy0 , int * pu0 , int * imemord , int * stag0 ,
97           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
98           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
99           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
100           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
101{
102#ifndef STUBMPI
103  int me, np, np_x, np_y ;
104  int shw , typesize ;
105  int ids , ide , jds , jde , kds , kde ;
106  int ims , ime , jms , jme , kms , kme ;
107  int ips , ipe , jps , jpe , kps , kpe ;
108  int stag ;  /* 0 not stag, 1 stag */
109  int xy ;   /* y = 0 , x = 1 */
110  int pu ;   /* pack = 0 , unpack = 1 */
111  register int i, j, k, t ;
112#ifdef crayx1
113  register int i2,i3,i4,i_offset;
114#endif
115  char *p ;
116  int the_buf ;
117  int yp, ym, xp, xm ;
118  int nbytes, ierr ;
119  register int *pi, *qi ;
120  int coords[2] ;
121  int js, je, ks, ke, is, ie, wcount ;
122  MPI_Comm comm, *comm0, dummy_comm ;
123
124  comm0 = &dummy_comm ;
125  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
126
127  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
128  stag = *stag0 ;
129  shw = *shw0 ; typesize = *typesize0 ;
130  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
131  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
132  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
133  xy = *xy0 ;
134  pu = *pu0 ;
135
136#define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*((E3)-(S3)+1)*((E4)-(S4)+1))
137#if 0
138#define IMAX(A) (((A)>ids)?(A):ids)
139#define IMIN(A) (((A)<ide)?(A):ide)
140#define JMAX(A) (((A)>jds)?(A):jds)
141#define JMIN(A) (((A)<jde)?(A):jde)
142#else
143/* allow the extent in other dimension to go into boundary region (e.g. < ids or > ide) since
144   this will handle corner points for doubly periodic updates (he wrote hopefully) */
145#define IMAX(A) (A)
146#define IMIN(A) (A)
147#define JMAX(A) (A)
148#define JMIN(A) (A)
149#endif
150
151  the_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
152
153  if ( np_x > 1 && xy == 1 ) {   /* exchange period in x dim */
154    MPI_Comm_rank( *comm0, &me ) ;
155    MPI_Cart_coords( *comm0, me, 2, coords ) ;
156    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
157    if ( coords[1] == np_x - 1 ) {                /* process on right hand edge of domain */
158      p = buffer_for_proc( xp , 0 , the_buf ) ;
159      if ( pu == 0 ) {
160        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
161        ks = kps           ; ke = kpe ;
162        is = ipe-shw       ; ie = ipe-1         ;
163        nbytes = buffer_size_for_proc( xp , the_buf ) ;
164        if ( xp_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ipe-shw, ipe-1, 1, typesize ) > nbytes ) {
165#ifndef MS_SUA
166          fprintf(stderr,"memory overwrite in rsl_lite_pack_period_x, right hand X to %d, %d > %d\n",xp,
167              xp_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ipe-shw, ipe-1, 1, typesize ), nbytes ) ;
168#endif
169          MPI_Abort(MPI_COMM_WORLD, 98) ;
170        }
171        if ( typesize == 8 ) {
172          F_PACK_LINT ( buf, p+xp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
173                                        &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
174          xp_curs += wcount*typesize ;
175        } else
176        if ( typesize == 4 ) {
177          F_PACK_INT ( buf, p+xp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
178                                       &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
179          xp_curs += wcount*typesize ;
180        }
181        else {
182#ifndef MS_SUA
183          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
184#endif
185        }
186      } else {
187        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
188        ks = kps           ; ke = kpe ;
189        is = ipe           ; ie = ipe+shw-1+stag ;
190        if ( typesize == 8 ) {
191          F_UNPACK_LINT ( p+xp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
192                                          &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
193          xp_curs += wcount*typesize ;
194        } else
195        if ( typesize == 4 ) {
196          F_UNPACK_INT ( p+xp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
197                                         &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
198          xp_curs += wcount*typesize ;
199        }
200        else {
201#ifndef MS_SUA
202          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
203#endif
204        }
205      }
206    }
207    if ( coords[1] == 0 ) {         /* process on left hand edge of domain */
208      p = buffer_for_proc( xm , 0 , the_buf ) ;
209      if ( pu == 0 ) {
210        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
211        ks = kps           ; ke = kpe ;
212        is = ips           ; ie = ips+shw-1+stag ;
213        nbytes = buffer_size_for_proc( xm , the_buf ) ;
214        if ( xm_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ips, ips+shw-1+stag, 1, typesize ) > nbytes ) {
215#ifndef MS_SUA
216          fprintf(stderr,"memory overwrite in rsl_lite_pack_period_x,  left hand X to %d , %d > %d\n",xm,
217              xm_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ips, ips+shw-1+stag, 1, typesize ), nbytes ) ;
218#endif
219          MPI_Abort(MPI_COMM_WORLD, 98) ;
220        }
221        if ( typesize == 8 ) {
222          F_PACK_LINT ( buf, p+xm_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
223                                        &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
224          xm_curs += wcount*typesize ;
225        } else
226        if ( typesize == 4 ) {
227          F_PACK_INT ( buf, p+xm_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
228                                       &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
229          xm_curs += wcount*typesize ;
230        }
231        else {
232#ifndef MS_SUA
233          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
234#endif
235        }
236      } else {
237        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
238        ks = kps           ; ke = kpe ;
239        is = ips-shw       ; ie = ips-1           ;
240        if ( typesize == 8 ) {
241          F_UNPACK_LINT ( p+xm_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
242                                          &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
243          xm_curs += wcount*typesize ;
244        } else
245        if ( typesize == 4 ) {
246          F_UNPACK_INT ( p+xm_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
247                                         &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
248          xm_curs += wcount*typesize ;
249        }
250        else {
251#ifndef MS_SUA
252          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
253#endif
254        }
255      }
256    }
257  }
258  if ( np_y > 1 && xy == 0 ) {    /* exchange period in Y dim */
259    MPI_Comm_rank( *comm0, &me ) ;
260    MPI_Cart_coords( *comm0, me, 2, coords ) ;
261    MPI_Cart_shift( *comm0, 0, 1, &ym, &yp ) ;
262    if ( coords[0] == np_y - 1 ) {                /* process on top edge of domain */
263      p = buffer_for_proc( yp , 0 , the_buf ) ;
264      if ( pu == 0 ) {
265        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
266        ks = kps           ; ke = kpe ;
267        js = jpe-shw       ; je = jpe-1         ;
268        nbytes = buffer_size_for_proc( yp , the_buf ) ;
269        if ( yp_curs + RANGE( IMAX(ips-shw), IMIN(ipe+shw), kps, kpe, jpe-shw, jpe-1, 1, typesize ) > nbytes ) {
270#ifndef MS_SUA
271          fprintf(stderr,"memory overwrite in rsl_lite_pack_period_y, right hand Y to %d, %d > %d\n",yp,
272              yp_curs + RANGE( IMAX(ips-shw), IMIN(ipe+shw), kps, kpe, jpe-shw, jpe-1, 1, typesize ), nbytes ) ;
273#endif
274          MPI_Abort(MPI_COMM_WORLD, 98) ;
275        }
276        if ( typesize == 8 ) {
277          F_PACK_LINT ( buf, p+yp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
278                                        &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
279          yp_curs += wcount*typesize ;
280        } else
281        if ( typesize == 4 ) {
282          F_PACK_INT ( buf, p+yp_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
283                                       &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
284          yp_curs += wcount*typesize ;
285        }
286        else {
287#ifndef MS_SUA
288          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
289#endif
290        }
291      } else {
292        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
293        ks = kps           ; ke = kpe ;
294        js = jpe           ; je = jpe+shw-1+stag ;
295        if ( typesize == 8 ) {
296          F_UNPACK_LINT ( p+yp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
297                                          &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
298          yp_curs += wcount*typesize ;
299        } else
300        if ( typesize == 4 ) {
301          F_UNPACK_INT ( p+yp_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
302                                         &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
303          yp_curs += wcount*typesize ;
304        }
305        else {
306#ifndef MS_SUA
307          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
308#endif
309        }
310      }
311    }
312    if ( coords[0] == 0 ) {         /* process on bottom edge of domain */
313      p = buffer_for_proc( ym , 0 , the_buf ) ;
314      if ( pu == 0 ) {
315        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
316        ks = kps           ; ke = kpe ;
317        js = jps           ; je = jps+shw-1+stag ;
318        nbytes = buffer_size_for_proc( ym , the_buf ) ;
319        if ( ym_curs + RANGE( IMAX(ips-shw), IMIN(ipe+shw), kps, kpe, jps, jps+shw-1+stag, 1, typesize ) > nbytes ) {
320#ifndef MS_SUA
321          fprintf(stderr,"memory overwrite in rsl_lite_pack_period_y,  left hand Y to %d , %d > %d\n",xm,
322              ym_curs + RANGE( IMAX(ips-shw), IMIN(ipe+shw), kps, kpe, jps, jps+shw-1+stag, 1, typesize ), nbytes ) ;
323#endif
324          MPI_Abort(MPI_COMM_WORLD, 98) ;
325        }
326        if ( typesize == 8 ) {
327          F_PACK_LINT ( buf, p+ym_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
328                                        &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
329          ym_curs += wcount*typesize ;
330        } else
331        if ( typesize == 4 ) {
332          F_PACK_INT ( buf, p+ym_curs, imemord, &js, &je, &ks, &ke, &is, &ie,
333                                       &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
334          ym_curs += wcount*typesize ;
335        }
336        else {
337#ifndef MS_SUA
338          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
339#endif
340        }
341      } else {
342        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
343        ks = kps           ; ke = kpe ;
344        js = jps-shw       ; je = jps-1           ;
345        if ( typesize == 8 ) {
346          F_UNPACK_LINT ( p+ym_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
347                                          &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
348          ym_curs += wcount*typesize ;
349        } else
350        if ( typesize == 4 ) {
351          F_UNPACK_INT ( p+ym_curs, buf, imemord, &js, &je, &ks, &ke, &is, &ie,
352                                         &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
353          ym_curs += wcount*typesize ;
354        }
355        else {
356#ifndef MS_SUA
357          fprintf(stderr,"internal error: %s %d\n",__FILE__,__LINE__) ;
358#endif
359        }
360      }
361    }
362  }
363#endif
364}
365
366#ifndef STUBMPI
367static MPI_Request yp_recv, ym_recv, yp_send, ym_send ;
368static MPI_Request xp_recv, xm_recv, xp_send, xm_send ;
369#endif
370
371RSL_LITE_EXCH_PERIOD_X ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
372{
373#ifndef STUBMPI
374  int me, np, np_x, np_y ;
375  int yp, ym, xp, xm, nbytes ;
376  MPI_Status stat ;
377  MPI_Comm comm, *comm0, dummy_comm ;
378  int coords[2] ;
379
380  comm0 = &dummy_comm ;
381  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
382#if 1
383  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
384
385  if ( np_x > 1 ) {
386    MPI_Comm_rank( *comm0, &me ) ;
387    MPI_Cart_coords( *comm0, me, 2, coords ) ;
388    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
389    if ( coords[1] == np_x - 1 ) {   /* proc on right hand side of domain */
390      nbytes = buffer_size_for_proc( xp, RSL_RECVBUF ) ;
391      MPI_Irecv ( buffer_for_proc( xp , xp_curs, RSL_RECVBUF ), nbytes, MPI_CHAR, xp, me, comm, &xp_recv ) ;
392    }
393    if ( coords[1] == 0 ) {          /* proc on left hand side of domain */
394      nbytes = buffer_size_for_proc( xm, RSL_RECVBUF ) ;
395      MPI_Irecv ( buffer_for_proc( xm, xm_curs, RSL_RECVBUF ), nbytes, MPI_CHAR, xm, me, comm, &xm_recv ) ;
396    }
397    if ( coords[1] == np_x - 1 ) {   /* proc on right hand side of domain */
398      MPI_Isend ( buffer_for_proc( xp , 0,       RSL_SENDBUF ), xp_curs, MPI_CHAR, xp, xp, comm, &xp_send ) ;
399    }
400    if ( coords[1] == 0 ) {          /* proc on left hand side of domain */
401      MPI_Isend ( buffer_for_proc( xm, 0,       RSL_SENDBUF ), xm_curs, MPI_CHAR, xm, xm, comm, &xm_send ) ;
402    }
403    if ( coords[1] == np_x - 1 ) MPI_Wait( &xp_recv, &stat ) ; 
404    if ( coords[1] == 0        ) MPI_Wait( &xm_recv, &stat ) ; 
405    if ( coords[1] == np_x - 1 ) MPI_Wait( &xp_send, &stat ) ; 
406    if ( coords[1] == 0        ) MPI_Wait( &xm_send, &stat ) ;
407  }
408#else
409# ifndef MS_SUA
410fprintf(stderr,"RSL_LITE_EXCH_PERIOD_X disabled\n") ;
411# endif
412#endif
413  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
414#endif
415}
416
417RSL_LITE_EXCH_PERIOD_Y ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
418{
419#ifndef STUBMPI
420  int me, np, np_x, np_y ;
421  int yp, ym, xp, xm, nbytes ;
422  MPI_Status stat ;
423  MPI_Comm comm, *comm0, dummy_comm ;
424  int coords[2] ;
425
426  comm0 = &dummy_comm ;
427  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
428#if 1
429  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
430
431  if ( np_y > 1 ) {
432    MPI_Comm_rank( *comm0, &me ) ;
433    MPI_Cart_coords( *comm0, me, 2, coords ) ;
434    MPI_Cart_shift( *comm0, 0, 1, &ym, &yp ) ;
435    if ( coords[0] == np_y - 1 ) {   /* proc on top of domain */
436      nbytes = buffer_size_for_proc( yp, RSL_RECVBUF ) ;
437      MPI_Irecv ( buffer_for_proc( yp , yp_curs, RSL_RECVBUF ), nbytes, MPI_CHAR, yp, me, comm, &yp_recv ) ;
438    }
439    if ( coords[0] == 0 ) {          /* proc on bottom of domain */
440      nbytes = buffer_size_for_proc( ym, RSL_RECVBUF ) ;
441      MPI_Irecv ( buffer_for_proc( ym, ym_curs, RSL_RECVBUF ), nbytes, MPI_CHAR, ym, me, comm, &ym_recv ) ;
442    }
443    if ( coords[0] == np_y - 1 ) {   /* proc on top of domain */
444      MPI_Isend ( buffer_for_proc( yp , 0,       RSL_SENDBUF ), yp_curs, MPI_CHAR, yp, yp, comm, &yp_send ) ;
445    }
446    if ( coords[0] == 0 ) {          /* proc on bottom of domain */
447      MPI_Isend ( buffer_for_proc( ym, 0,       RSL_SENDBUF ), ym_curs, MPI_CHAR, ym, ym, comm, &ym_send ) ;
448    }
449    if ( coords[0] == np_y - 1 ) MPI_Wait( &yp_recv, &stat ) ;
450    if ( coords[0] == 0        ) MPI_Wait( &ym_recv, &stat ) ;
451    if ( coords[0] == np_y - 1 ) MPI_Wait( &yp_send, &stat ) ;
452    if ( coords[0] == 0        ) MPI_Wait( &ym_send, &stat ) ;
453  }
454#else
455# ifndef MS_SUA
456fprintf(stderr,"RSL_LITE_EXCH_PERIOD_Y disabled\n") ;
457# endif
458#endif
459  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
460#endif
461}
462
Note: See TracBrowser for help on using the repository browser.