source: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/cycle.c @ 2756

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

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