source: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/swap.c

Last change on this file was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 10.8 KB
Line 
1#include <stdio.h>
2#include <fcntl.h>
3
4#define STANDARD_ERROR 2
5
6#define STANDARD_OUTPUT 1
7
8#include "mpi.h"
9#include "rsl_lite.h"
10
11#define  UP_EVEN(A)   ((A)+abs((A)%2))
12#define  DOWN_EVEN(A) ((A) - abs((A)%2))
13#define  UP_ODD(A)    ((A) + abs(((A)+1)%2))
14#define  DOWN_ODD(A)  ((A) - abs(((A)+1)%2))
15#define  MIN(A,B)     ((A)<(B)?(A):(B))
16#define  MAX(A,B)     ((A)>(B)?(A):(B))
17
18static int *y_curs = NULL ;
19static int *x_curs = NULL ;
20static int *x_peermask = NULL ;
21static int *nbytes = NULL ; 
22static MPI_Request *x_recv = NULL , *x_send = NULL ;
23
24RSL_LITE_INIT_SWAP ( 
25                int * Fcomm ,
26                int * xy0 ,
27                int * n3dR0, int *n2dR0, int * typesizeR0 , 
28                int * n3dI0, int *n2dI0, int * typesizeI0 , 
29                int * n3dD0, int *n2dD0, int * typesizeD0 , 
30                int * n3dL0, int *n2dL0, int * typesizeL0 , 
31                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
32                int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
33                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
34{
35  int n3dR, n2dR, typesizeR ;
36  int n3dI, n2dI, typesizeI ;
37  int n3dD, n2dD, typesizeD ;
38  int n3dL, n2dL, typesizeL ;
39  int xy ;
40  int me, np, np_x, np_y ;
41  int ids , ide , jds , jde , kds , kde ;
42  int ips , ipe , jps , jpe , kps , kpe ;
43  int ips_send , ipe_send ;
44  int npts, i, ii, j, m, n, ps, pe, ops, ope ;
45  int Px, Py, P, coords[2] ;
46  int ips_swap, ipe_swap ;
47  MPI_Comm *comm, dummy_comm ;
48
49  comm = &dummy_comm ;
50  *comm = MPI_Comm_f2c( *Fcomm ) ;
51
52  xy = *xy0 ;
53  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
54  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
55  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
56  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
57  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
58  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
59  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
60
61  if ( nbytes == NULL ) nbytes = RSL_MALLOC ( int , np ) ;
62  if ( x_curs == NULL ) x_curs = RSL_MALLOC ( int , np ) ;
63  if ( x_peermask == NULL ) x_peermask = RSL_MALLOC ( int , np ) ;
64  if ( x_recv == NULL ) x_recv = RSL_MALLOC ( MPI_Request , np ) ;
65  if ( x_send == NULL ) x_send = RSL_MALLOC ( MPI_Request , np ) ;
66  for ( i = 0 ; i < np ; i++ ) { nbytes[i] = 0 ; x_curs[i] = 0 ; x_peermask[i] = 0 ; }
67
68  if ( xy == 1 ) {   /* xy = 1, swap in X, otherwise Y */
69    n = (ide-ids+1)/4*2 ;
70    m = n*2 ;
71    ps = ips ;
72    pe = ipe ;
73    ops = jps ;
74    ope = jpe ;
75  } else {
76    n = (jde-jds+1)/4*2 ;
77    m = n*2 ;
78    ps = jps ;
79    pe = jpe ;
80    ops = ips ;
81    ope = ipe ;
82  }
83
84  for ( i = UP_ODD( ps ) ; i <= MIN(pe,m) ; i+=2 ) {
85    ii = abs(i+n) % m ;
86    if ( xy == 1 ) {
87      TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
88      coords[1] = Px ; coords[0] = Py ;
89      MPI_Cart_rank( *comm, coords, &P ) ;
90    } else {
91      TASK_FOR_POINT ( &ips , &ii , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
92      coords[1] = Px ; coords[0] = Py ;
93      MPI_Cart_rank( *comm, coords, &P ) ;
94    }
95    nbytes[P] += typesizeR*(ope-ops+1)*(n3dR*(kpe-kps+1)+n2dR) +
96                 typesizeI*(ope-ops+1)*(n3dI*(kpe-kps+1)+n2dI) +
97                 typesizeD*(ope-ops+1)*(n3dD*(kpe-kps+1)+n2dD) +
98                 typesizeL*(ope-ops+1)*(n3dL*(kpe-kps+1)+n2dL) ;
99    x_peermask[P] = 1 ;
100  }
101
102  for ( P = 0 ; P < np ; P++ ) {
103     if ( x_peermask[P] ) {
104       buffer_for_proc ( P , nbytes[P], RSL_RECVBUF ) ;
105       buffer_for_proc ( P , nbytes[P], RSL_SENDBUF ) ;
106     }
107  }
108}
109
110RSL_LITE_PACK_SWAP ( int * Fcomm , char * buf , int * odd0 , int * typesize0 , int * xy0 , int * pu0 , char * memord , int * xstag0 ,
111           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
112           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
113           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
114           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
115{
116  int me, np, np_x, np_y ;
117  int odd , typesize ;
118  int ids , ide , jds , jde , kds , kde ;
119  int ims , ime , jms , jme , kms , kme ;
120  int ips , ipe , jps , jpe , kps , kpe ;
121  int xstag ;  /* 0 not stag, 1 stag */
122  int xy ;   /* y = 0 , x = 1 */
123  int pu ;   /* pack = 0 , unpack = 1 */
124  int i, ii, j, jj, m, n  ;
125  int ps, pe, ops, ope ;
126  register int k, t ;
127#ifdef crayx1
128  register int i2,i3,i4,i_offset;
129#endif
130  char *p ;
131  int da_buf ;
132  int Px, Py, P, coords[2] ;
133  int ierr = 0 ;
134  register int *pi, *qi ;
135  float f ;
136  MPI_Comm *comm, dummy_comm ;
137
138  comm = &dummy_comm ;
139  *comm = MPI_Comm_f2c( *Fcomm ) ;
140
141  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
142  xstag = *xstag0 ;
143  odd = *odd0 ; typesize = *typesize0 ;
144  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
145  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
146  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
147  xy = *xy0 ;
148  pu = *pu0 ;
149
150/* need to adapt for other memory orders */
151#define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*(((E3)-(S3)+1)/2)*((E4)-(S4)+1))
152#define IMAX(A) (((A)>ids)?(A):ids)
153#define IMIN(A) (((A)<ide)?(A):ide)
154#define JMAX(A) (((A)>jds)?(A):jds)
155#define JMIN(A) (((A)<jde)?(A):jde)
156
157  da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
158
159
160  if ( xy == 1 ) {   /* xy = 1, swap in X, otherwise Y */
161    n = (ide-ids+1)/4*2 ;
162    m = n*2 ;
163  } else {
164    n = (jde-jds+1)/4*2 ;
165    m = n*2 ;
166  }
167
168  if ( np_x > 1 && xy == 1 ) {
169
170    for ( i = UP_ODD(ips) ; i <= MIN(ipe,m) ; i+=2 ) {
171      ii = abs(i+n) % m ;
172      TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
173      coords[1] = Px ; coords[0] = Py ;
174      MPI_Cart_rank( *comm, coords, &P ) ;
175      p = buffer_for_proc( P , 0 , da_buf ) ;
176      if ( pu == 0 ) {
177        if ( typesize == sizeof(int) ) {
178          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
179            for ( k = kps ; k <= kpe ; k++ ) {
180              pi = (int *)(p+x_curs[P]) ;
181              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
182                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
183              *pi++ = *qi++ ;
184              x_curs[P] += typesize ;
185            }
186          }
187        }
188        else {
189          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
190            for ( k = kps ; k <= kpe ; k++ ) {
191              for ( t = 0 ; t < typesize ; t++ ) {
192                *(p+x_curs[P]) = 
193                               *(buf + t + typesize*(
194                                      (i-ims) + (ime-ims+1)*(
195                                      (k-kms) + (j-jms)*(kme-kms+1))) ) ;
196                x_curs[P]++ ;
197              }
198            }
199          }
200        }
201      } else {
202        if ( typesize == sizeof(int) ) {
203          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
204            for ( k = kps ; k <= kpe ; k++ ) {
205              pi = (int *)(p+x_curs[P]) ;
206              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
207                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
208              *qi++ = *pi++ ;
209              x_curs[P] += typesize ;
210            }
211          }
212        }
213        else {
214          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
215            for ( k = kps ; k <= kpe ; k++ ) {
216              for ( t = 0 ; t < typesize ; t++ ) {
217                               *(buf + t + typesize*(
218                                      (i-ims) + (ime-ims+1)*(
219                                      (k-kms) + (j-jms)*(kme-kms+1))) ) =
220                *(p+x_curs[P]) ;
221                x_curs[P]++ ;
222              }
223            }
224          }
225        }
226      }
227    }
228  } else if ( np_y > 1 && xy == 0 ) {
229    for ( j = UP_ODD(jps) ; j <= MIN(jpe,m) ; j+=2 ) {
230      jj = abs(j+n) % m ;
231      TASK_FOR_POINT ( &ips , &jj , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
232      coords[1] = Px ; coords[0] = Py ;
233      MPI_Cart_rank( *comm, coords, &P ) ;
234      p = buffer_for_proc( P , 0 , da_buf ) ;
235      if ( pu == 0 ) {
236        if ( typesize == sizeof(int) ) {
237          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
238            for ( k = kps ; k <= kpe ; k++ ) {
239              pi = (int *)(p+x_curs[P]) ;
240              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
241                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
242              *pi++ = *qi++ ;
243              x_curs[P] += typesize ;
244            }
245          }
246        }
247        else {
248          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
249            for ( k = kps ; k <= kpe ; k++ ) {
250              for ( t = 0 ; t < typesize ; t++ ) {
251                *(p+x_curs[P]) = 
252                               *(buf + t + typesize*(
253                                      (i-ims) + (ime-ims+1)*(
254                                      (k-kms) + (j-jms)*(kme-kms+1))) ) ;
255                x_curs[P]++ ;
256              }
257            }
258          }
259        }
260      } else {
261        if ( typesize == sizeof(int) ) {
262          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
263            for ( k = kps ; k <= kpe ; k++ ) {
264              pi = (int *)(p+x_curs[P]) ;
265              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
266                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
267              *qi++ = *pi++ ;
268              x_curs[P] += typesize ;
269            }
270          }
271        }
272        else {
273          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
274            for ( k = kps ; k <= kpe ; k++ ) {
275              for ( t = 0 ; t < typesize ; t++ ) {
276                               *(buf + t + typesize*(
277                                      (i-ims) + (ime-ims+1)*(
278                                      (k-kms) + (j-jms)*(kme-kms+1))) ) =
279                *(p+x_curs[P]) ;
280                x_curs[P]++ ;
281              }
282            }
283          }
284        }
285      }
286    }
287  }
288}
289
290RSL_LITE_SWAP ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
291{
292  int me, np, np_x, np_y ;
293  int yp, ym, xp, xm, nb ;
294  MPI_Status stat ;
295  MPI_Comm comm, *comm0, dummy_comm ;
296  int i, P ;
297
298  comm0 = &dummy_comm ;
299  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
300#if 1
301
302  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
303
304/* fprintf(stderr,"RSL_LITE_SWAP\n") ; */
305
306  for ( P = 0 ; P < np ; P++ ) {
307    if ( x_peermask[P] ) {
308      nb = buffer_size_for_proc( P, RSL_RECVBUF ) ;
309/* fprintf(stderr,"posting irecv from %d, nb = %d\n",P,nb) ; */
310      MPI_Irecv ( buffer_for_proc( P, x_curs[P], RSL_RECVBUF ), nb, MPI_CHAR, P, me, comm, &(x_recv[P]) ) ;
311/* fprintf(stderr,"sending to         %d, nb = %d\n",P,x_curs[P]) ; */
312      MPI_Isend ( buffer_for_proc( P, 0,         RSL_SENDBUF ), x_curs[P], MPI_CHAR, P, P, comm, &(x_send[P]) ) ;
313    }
314  }
315  for ( P = 0 ; P < np ; P++ ) {
316    if ( x_peermask[P] ) {
317      MPI_Wait( &x_recv[P], &stat ) ; 
318      MPI_Wait( &x_send[P], &stat ) ; 
319    }
320  }
321#else
322fprintf(stderr,"RSL_LITE_SWAP disabled\n") ;
323#endif
324  for ( i = 0 ; i < np ; i++ ) {  x_curs[i] = 0 ;  }
325}
326
Note: See TracBrowser for help on using the repository browser.