source: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/c_code.c @ 3553

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

spiga@svn-planeto:ajoute le modele meso-echelle martien
  • Property svn:executable set to *
File size: 25.4 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 F_PACK
12
13RSL_LITE_ERROR_DUP1 ( int *me )
14{
15    int newfd ;
16    char filename[256] ;
17    char hostname[256] ;
18
19    gethostname( hostname, 256 ) ;
20
21/* redirect standard out*/
22    sprintf(filename,"rsl.out.%04d",*me) ;
23    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
24    {
25        perror("error_dup: cannot open rsl.out.nnnn") ;
26        fprintf(stderr,"...sending output to standard output and continuing.\n") ;
27        return ;
28    }
29    if( dup2( newfd, STANDARD_OUTPUT ) < 0 )
30    {
31        perror("error_dup: dup2 fails to change output descriptor") ;
32        fprintf(stderr,"...sending output to standard output and continuing.\n") ;
33        close(newfd) ;
34        return ;
35    }
36
37/* redirect standard error */
38    sprintf(filename,"rsl.error.%04d",*me) ;
39    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
40    {
41        perror("error_dup: cannot open rsl.error.log") ;
42        fprintf(stderr,"...sending error to standard error and continuing.\n") ;
43        return ;
44    }
45    if( dup2( newfd, STANDARD_ERROR ) < 0 )
46    {
47        perror("error_dup: dup2 fails to change error descriptor") ;
48        fprintf(stderr,"...sending error to standard error and continuing.\n") ;
49        close(newfd) ;
50        return ;
51    }
52    fprintf( stdout, "taskid: %d hostname: %s\n",*me,hostname) ;
53    fprintf( stderr, "taskid: %d hostname: %s\n",*me,hostname) ;
54
55}
56
57BYTE_BCAST ( char * buf, int * size, int * Fcomm )
58{
59    MPI_Comm *comm, dummy_comm ;
60
61    comm = &dummy_comm ;
62    *comm = MPI_Comm_f2c( *Fcomm ) ;
63#ifdef crayx1
64    if (*size % sizeof(int) == 0) {
65       MPI_Bcast ( buf, *size/sizeof(int), MPI_INT, 0, *comm ) ;
66    } else {
67       MPI_Bcast ( buf, *size, MPI_BYTE, 0, *comm ) ;
68    }
69#else
70    MPI_Bcast ( buf, *size, MPI_BYTE, 0, *comm ) ;
71#endif
72}
73
74static int yp_curs, ym_curs, xp_curs, xm_curs ;
75
76RSL_LITE_INIT_EXCH ( 
77                int * Fcomm0,
78                int * shw0,
79                int * n3dR0, int *n2dR0, int * typesizeR0 , 
80                int * n3dI0, int *n2dI0, int * typesizeI0 , 
81                int * n3dD0, int *n2dD0, int * typesizeD0 , 
82                int * n3dL0, int *n2dL0, int * typesizeL0 , 
83                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
84                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
85{
86  int n3dR, n2dR, typesizeR ;
87  int n3dI, n2dI, typesizeI ;
88  int n3dD, n2dD, typesizeD ;
89  int n3dL, n2dL, typesizeL ;
90  int shw ;
91  int me, np, np_x, np_y ;
92  int ips , ipe , jps , jpe , kps , kpe ;
93  int yp, ym, xp, xm ;
94  int nbytes ;
95  MPI_Comm comm, *comm0, dummy_comm ;
96
97  comm0 = &dummy_comm ;
98  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
99
100  shw = *shw0 ;
101  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
102  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
103  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
104  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
105  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
106  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
107
108#if 1
109
110  if ( np_y > 1 ) {
111    nbytes = typesizeR*(ipe-ips+1+2*shw)*shw*(n3dR*(kpe-kps+1)+n2dR) +
112             typesizeI*(ipe-ips+1+2*shw)*shw*(n3dI*(kpe-kps+1)+n2dI) +
113             typesizeD*(ipe-ips+1+2*shw)*shw*(n3dD*(kpe-kps+1)+n2dD) +
114             typesizeL*(ipe-ips+1+2*shw)*shw*(n3dL*(kpe-kps+1)+n2dL) ;
115    MPI_Cart_shift ( *comm0, 0, 1, &ym, &yp ) ;
116    if ( yp != MPI_PROC_NULL ) {
117       buffer_for_proc ( yp , nbytes, RSL_RECVBUF ) ;
118       buffer_for_proc ( yp , nbytes, RSL_SENDBUF ) ;
119    }
120    if ( ym != MPI_PROC_NULL ) {
121       buffer_for_proc ( ym , nbytes, RSL_RECVBUF ) ;
122       buffer_for_proc ( ym , nbytes, RSL_SENDBUF ) ;
123    }
124  }
125  if ( np_x > 1 ) {
126    nbytes = typesizeR*(jpe-jps+1+2*shw)*shw*(n3dR*(kpe-kps+1)+n2dR) +
127             typesizeI*(jpe-jps+1+2*shw)*shw*(n3dI*(kpe-kps+1)+n2dI) +
128             typesizeD*(jpe-jps+1+2*shw)*shw*(n3dD*(kpe-kps+1)+n2dD) +
129             typesizeL*(jpe-jps+1+2*shw)*shw*(n3dL*(kpe-kps+1)+n2dL) ;
130    MPI_Cart_shift ( *comm0, 1, 1, &xm, &xp ) ;
131    if ( xp != MPI_PROC_NULL ) {
132       buffer_for_proc ( xp , nbytes, RSL_RECVBUF ) ;
133       buffer_for_proc ( xp , nbytes, RSL_SENDBUF ) ;
134    }
135    if ( xm != MPI_PROC_NULL ) {
136       buffer_for_proc ( xm , nbytes, RSL_RECVBUF ) ;
137       buffer_for_proc ( xm , nbytes, RSL_SENDBUF ) ;
138    }
139  }
140#endif
141  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
142}
143
144RSL_LITE_PACK ( int * Fcomm0, char * buf , int * shw0 , int * typesize0 , int * xy0 , int * pu0 , char * memord , int * xstag0, /* not used */
145           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
146           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
147           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
148           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
149{
150  int me, np, np_x, np_y ;
151  int shw , typesize ;
152  int ids , ide , jds , jde , kds , kde ;
153  int ims , ime , jms , jme , kms , kme ;
154  int ips , ipe , jps , jpe , kps , kpe ;
155  int xy ;   /* y = 0 , x = 1 */
156  int pu ;   /* pack = 0 , unpack = 1 */
157  register int i, j, k, t ;
158#ifdef crayx1
159  register int i2,i3,i4,i_offset;
160#endif
161  char *p ;
162  int da_buf ;
163  int yp, ym, xp, xm ;
164  int nbytes, ierr ;
165  register int *pi, *qi ;
166  MPI_Comm comm, *comm0, dummy_comm ;
167  int js, je, ks, ke, is, ie, wcount ;
168
169  comm0 = &dummy_comm ;
170  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
171
172  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
173  shw = *shw0 ; typesize = *typesize0 ;
174  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
175  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
176  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
177  xy = *xy0 ;
178  pu = *pu0 ;
179
180/* need to adapt for other memory orders */
181
182#define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*((E3)-(S3)+1)*((E4)-(S4)+1))
183#define IMAX(A) (((A)>ids)?(A):ids)
184#define IMIN(A) (((A)<ide)?(A):ide)
185#define JMAX(A) (((A)>jds)?(A):jds)
186#define JMIN(A) (((A)<jde)?(A):jde)
187
188  da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
189
190  if ( np_y > 1 && xy == 0 ) {
191    MPI_Cart_shift( *comm0 , 0, 1, &ym, &yp ) ;
192    if ( yp != MPI_PROC_NULL ) {
193      p = buffer_for_proc( yp , 0 , da_buf ) ;
194      if ( pu == 0 ) {
195        js = jpe-shw+1     ; je = jpe ;
196        ks = kps           ; ke = kpe ;
197        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
198        nbytes = buffer_size_for_proc( yp, da_buf ) ;
199        if ( yp_curs + RANGE( jpe-shw+1, jpe, kps, kpe, ips-shw, ipe+shw, 1, typesize ) > nbytes ) {
200          fprintf(stderr,"memory overwrite in rsl_lite_pack, Y pack up, %d > %d\n",
201              yp_curs + RANGE( jpe-shw+1, jpe, kps, kpe, ips-shw, ipe+shw, 1, typesize ), nbytes ) ;
202          MPI_Abort(MPI_COMM_WORLD, 99) ;
203        }
204        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
205          F_PACK_LINT ( buf, p+yp_curs, &js, &je, &ks, &ke, &is, &ie, 
206                                              &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
207          yp_curs += wcount*typesize ;
208        }
209        else if ( typesize == sizeof(int) ) {
210#ifdef F_PACK
211          F_PACK_INT ( buf, p+yp_curs, &js, &je, &ks, &ke, &is, &ie,
212                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
213          yp_curs += wcount*typesize ;
214#else
215          wcount = 0 ;
216          for ( j = jpe-shw+1 ; j <= jpe ; j++ ) {
217            for ( k = kps ; k <= kpe ; k++ ) {
218              pi = (int *)(p+yp_curs) ;
219              i = IMAX(ips-shw) ;
220              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
221                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
222              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
223                *pi++ = *qi++ ;
224                wcount++ ;
225              }
226              yp_curs += (i-(ips-shw))*typesize ;
227            }
228          }
229#endif
230        }
231        else {
232          for ( j = jpe-shw+1 ; j <= jpe ; j++ ) {
233            for ( k = kps ; k <= kpe ; k++ ) {
234              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
235                for ( t = 0 ; t < typesize ; t++ ) {
236                  *(p+yp_curs) = 
237                                 *(buf + t + typesize*(
238                                        (i-ims) + (ime-ims+1)*(
239                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
240                  yp_curs++ ;
241                }
242              }
243            }
244          }
245        }
246      } else {
247        js = jpe+1         ; je = jpe+shw ;
248        ks = kps           ; ke = kpe ;
249        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
250        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
251          F_UNPACK_LINT ( p+yp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
252                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
253          yp_curs += wcount*typesize ;
254        }
255        else if ( typesize == sizeof(int) ) {
256#ifdef F_PACK
257          F_UNPACK_INT ( p+yp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
258                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
259          yp_curs += wcount*typesize ;
260#else
261          for ( j = jpe+1 ; j <= jpe+shw ; j++ ) {
262            for ( k = kps ; k <= kpe ; k++ ) {
263              pi = (int *)(p+yp_curs) ;
264              i = IMAX(ips-shw) ;
265              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
266                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
267              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
268                *qi++ = *pi++ ;
269              }
270              yp_curs += (i-(ips-shw))*typesize ;
271            }
272          }
273#endif
274        }
275        else {
276          for ( j = jpe+1 ; j <= jpe+shw ; j++ ) {
277            for ( k = kps ; k <= kpe ; k++ ) {
278              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
279                for ( t = 0 ; t < typesize ; t++ ) {
280                                 *(buf + t + typesize*(
281                                        (i-ims) + (ime-ims+1)*(
282                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
283                  *(p+yp_curs) ;
284                  yp_curs++ ;
285                }
286              }
287            }
288          }
289        }
290      }
291    }
292    if ( ym != MPI_PROC_NULL ) {
293      p = buffer_for_proc( ym , 0 , da_buf ) ;
294      if ( pu == 0 ) {
295        js = jps           ; je = jps+shw-1 ;
296        ks = kps           ; ke = kpe ;
297        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
298        nbytes = buffer_size_for_proc( ym, da_buf ) ;
299        if ( ym_curs + RANGE( jps, jps+shw-1, kps, kpe, ips-shw, ipe+shw, 1, typesize ) > nbytes ) {
300          fprintf(stderr,"memory overwrite in rsl_lite_pack, Y pack dn, %d > %d\n",
301              ym_curs + RANGE( jps, jps+shw-1, kps, kpe, ips-shw, ipe+shw, 1, typesize ), nbytes ) ;
302          MPI_Abort(MPI_COMM_WORLD, 99) ;
303        }
304        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
305          F_PACK_LINT ( buf, p+ym_curs, &js, &je, &ks, &ke, &is, &ie,
306                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
307          ym_curs += wcount*typesize ;
308        }
309        else if ( typesize == sizeof(int) ) {
310#ifdef F_PACK
311          F_PACK_INT ( buf, p+ym_curs, &js, &je, &ks, &ke, &is, &ie,
312                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
313          ym_curs += wcount*typesize ;
314#else
315          wcount = 0 ;
316          for ( j = jps ; j <= jps+shw-1 ; j++ ) {
317            for ( k = kps ; k <= kpe ; k++ ) {
318              pi = (int *)(p+ym_curs) ;
319              i = IMAX(ips-shw) ;
320              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
321                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
322              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
323                *pi++ = *qi++ ;
324                wcount++ ;
325              }
326              ym_curs += (i-(ips-shw))*typesize ;
327            }
328          }
329#endif
330        }
331        else {
332          for ( j = jps ; j <= jps+shw-1 ; j++ ) {
333            for ( k = kps ; k <= kpe ; k++ ) {
334              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
335                for ( t = 0 ; t < typesize ; t++ ) {
336                  *(p+ym_curs) = 
337                                 *(buf + t + typesize*(
338                                        (i-ims) + (ime-ims+1)*(
339                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
340                  ym_curs++ ;
341                }
342              }
343            }
344          }
345        }
346      } else {
347        js = jps-shw       ; je = jps-1 ;
348        ks = kps           ; ke = kpe ;
349        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
350        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
351          F_UNPACK_LINT ( p+ym_curs, buf, &js, &je, &ks, &ke, &is, &ie,
352                                                &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
353          ym_curs += wcount*typesize ;
354        }
355        else if ( typesize == sizeof(int) ) {
356#ifdef F_PACK
357          F_UNPACK_INT ( p+ym_curs, buf, &js, &je, &ks, &ke, &is, &ie,
358                                               &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
359          ym_curs += wcount*typesize ;
360#else
361         for ( j = jps-shw ; j <= jps-1 ; j++ ) {
362            for ( k = kps ; k <= kpe ; k++ ) {
363              pi = (int *)(p+ym_curs) ;
364              i = IMAX(ips-shw) ;
365              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
366                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
367              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
368                *qi++ = *pi++ ;
369              }
370              ym_curs += (i-(ips-shw))*typesize ;
371            }
372          }
373#endif
374        }
375        else {
376          for ( j = jps-shw ; j <= jps-1 ; j++ ) {
377            for ( k = kps ; k <= kpe ; k++ ) {
378              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
379                for ( t = 0 ; t < typesize ; t++ ) {
380                                 *(buf + t + typesize*(
381                                        (i-ims) + (ime-ims+1)*(
382                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
383                  *(p+ym_curs)  ;
384                  ym_curs++ ;
385                }
386              }
387            }
388          }
389        }
390      }
391    }
392  }
393
394  if ( np_x > 1 && xy == 1 ) {
395    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
396    if ( xp != MPI_PROC_NULL ) {
397      p = buffer_for_proc( xp , 0 , da_buf ) ;
398      if ( pu == 0 ) {
399        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
400        ks = kps           ; ke = kpe ;
401        is = ipe-shw+1     ; ie = ipe ;
402        nbytes = buffer_size_for_proc( xp, da_buf ) ;
403        if ( xp_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ipe-shw+1, ipe, 1, typesize ) > nbytes ) {
404          fprintf(stderr,"memory overwrite in rsl_lite_pack, X pack right, %d > %d\n",
405              xp_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ipe-shw+1, ipe, 1, typesize ), nbytes ) ;
406          MPI_Abort(MPI_COMM_WORLD, 99) ;
407        }
408        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
409          F_PACK_LINT ( buf, p+xp_curs, &js, &je, &ks, &ke, &is, &ie,
410                                              &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
411          xp_curs += wcount*typesize ;
412        }
413        else if ( typesize == sizeof(int) ) {
414#ifdef F_PACK
415          F_PACK_INT ( buf, p+xp_curs, &js, &je, &ks, &ke, &is, &ie,
416                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
417          xp_curs += wcount*typesize ;
418#else
419          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
420            for ( k = kps ; k <= kpe ; k++ ) {
421              pi = (int *)(p+xp_curs) ;
422              i = ipe-shw+1 ;
423              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
424                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
425              for ( i = ipe-shw+1 ; i <= ipe ; i++ ) {
426                *pi++ = *qi++ ;
427              }
428              xp_curs += shw*typesize ;
429            }
430          }
431#endif
432        }
433        else {
434          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
435            for ( k = kps ; k <= kpe ; k++ ) {
436              for ( i = ipe-shw+1 ; i <= ipe ; i++ ) {
437                for ( t = 0 ; t < typesize ; t++ ) {
438                  *(p+xp_curs) = 
439                                 *(buf + t + typesize*(
440                                        (i-ims) + (ime-ims+1)*(
441                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
442                  xp_curs++ ;
443                }
444              }
445            }
446          }
447        }
448      } else {
449        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
450        ks = kps           ; ke = kpe ;
451        is = ipe+1         ; ie = ipe+shw ;
452        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
453          F_UNPACK_LINT ( p+xp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
454                                                &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
455          xp_curs += wcount*typesize ;
456        }
457        else if ( typesize == sizeof(int) ) {
458#ifdef F_PACK
459          F_UNPACK_INT ( p+xp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
460                                               &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
461          xp_curs += wcount*typesize ;
462#else
463          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
464            for ( k = kps ; k <= kpe ; k++ ) {
465              pi = (int *)(p+xp_curs) ;
466              i = ipe+1 ;
467              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
468                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
469              for ( i = ipe+1 ; i <= ipe+shw ; i++ ) {
470                *qi++ = *pi++ ;
471              }
472              xp_curs += shw*typesize ;
473            }
474          }
475#endif
476        }
477        else {
478          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
479            for ( k = kps ; k <= kpe ; k++ ) {
480              for ( i = ipe+1 ; i <= ipe+shw ; i++ ) {
481                for ( t = 0 ; t < typesize ; t++ ) {
482                                 *(buf + t + typesize*(
483                                        (i-ims) + (ime-ims+1)*(
484                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
485                  *(p+xp_curs) ;
486                  xp_curs++ ;
487                }
488              }
489            }
490          }
491        }
492      }
493    }
494    if ( xm != MPI_PROC_NULL ) {
495      p = buffer_for_proc( xm , 0 , da_buf ) ;
496      if ( pu == 0 ) {
497        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
498        ks = kps           ; ke = kpe ;
499        is = ips           ; ie = ips+shw-1 ;
500        nbytes = buffer_size_for_proc( xm, da_buf ) ;
501        if ( xm_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ips, ips+shw-1, 1, typesize ) > nbytes ) {
502          fprintf(stderr,"memory overwrite in rsl_lite_pack, X left , %d > %d\n",
503              xm_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ips, ips+shw-1, 1, typesize ), nbytes ) ;
504          MPI_Abort(MPI_COMM_WORLD, 99) ;
505        }
506        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
507          F_PACK_LINT ( buf, p+xm_curs, &js, &je, &ks, &ke, &is, &ie,
508                                              &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
509          xm_curs += wcount*typesize ;
510        }
511        else if ( typesize == sizeof(int) ) {
512#ifdef F_PACK
513          F_PACK_INT ( buf, p+xm_curs, &js, &je, &ks, &ke, &is, &ie,
514                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
515          xm_curs += wcount*typesize ;
516#else
517          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
518            for ( k = kps ; k <= kpe ; k++ ) {
519              pi = (int *)(p+xm_curs) ;
520              i = ips ;
521              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
522                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
523              for ( i = ips ; i <= ips+shw-1 ; i++ ) {
524                *pi++ = *qi++ ;
525              }
526              xm_curs += shw*typesize ;
527            }
528          }
529#endif
530        }
531        else {
532          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
533            for ( k = kps ; k <= kpe ; k++ ) {
534              for ( i = ips ; i <= ips+shw-1 ; i++ ) {
535                for ( t = 0 ; t < typesize ; t++ ) {
536                  *(p+xm_curs) = 
537                                 *(buf + t + typesize*(
538                                        (i-ims) + (ime-ims+1)*(
539                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
540                  xm_curs++ ;
541                }
542              }
543            }
544          }
545        }
546      } else {
547        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
548        ks = kps           ; ke = kpe ;
549        is = ips-shw       ; ie = ips-1 ;
550        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
551          F_UNPACK_LINT ( p+xm_curs, buf, &js, &je, &ks, &ke, &is, &ie,
552                                                &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
553          xm_curs += wcount*typesize ;
554        } 
555        else if ( typesize == sizeof(int) ) {
556#ifdef F_PACK
557          F_UNPACK_INT ( p+xm_curs, buf, &js, &je, &ks, &ke, &is, &ie,
558                                               &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
559          xm_curs += wcount*typesize ;
560#else
561          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
562            for ( k = kps ; k <= kpe ; k++ ) {
563              pi = (int *)(p+xm_curs) ;
564              i = ips-shw ;
565              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
566                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
567              for ( i = ips-shw ; i <= ips-1 ; i++ ) {
568                *qi++ = *pi++ ;
569              }
570              xm_curs += shw*typesize ;
571            }
572          }
573#endif
574        }
575        else {
576          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
577            for ( k = kps ; k <= kpe ; k++ ) {
578              for ( i = ips-shw ; i <= ips-1 ; i++ ) {
579                for ( t = 0 ; t < typesize ; t++ ) {
580                                 *(buf + t + typesize*(
581                                        (i-ims) + (ime-ims+1)*(
582                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
583                  *(p+xm_curs) ;
584                  xm_curs++ ;
585                }
586              }
587            }
588          }
589        }
590      }
591    }
592  }
593}
594
595static MPI_Request yp_recv, ym_recv, yp_send, ym_send ;
596static MPI_Request xp_recv, xm_recv, xp_send, xm_send ;
597
598RSL_LITE_EXCH_Y ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
599{
600  int me, np, np_x, np_y ;
601  int yp, ym, xp, xm, ierr ;
602  MPI_Status stat ;
603  MPI_Comm comm, *comm0, dummy_comm ;
604
605  comm0 = &dummy_comm ;
606  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
607#if 1
608  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
609  if ( np_y > 1 ) {
610    MPI_Cart_shift( *comm0, 0, 1, &ym, &yp ) ;
611    if ( yp != MPI_PROC_NULL ) {
612      ierr=MPI_Irecv ( buffer_for_proc( yp, yp_curs, RSL_RECVBUF ), yp_curs, MPI_CHAR, yp, me, comm, &yp_recv ) ;
613    }
614    if ( ym != MPI_PROC_NULL ) {
615      ierr=MPI_Irecv ( buffer_for_proc( ym, ym_curs, RSL_RECVBUF ), ym_curs, MPI_CHAR, ym, me, comm, &ym_recv ) ;
616    }
617    if ( yp != MPI_PROC_NULL ) {
618      ierr=MPI_Isend ( buffer_for_proc( yp, 0,       RSL_SENDBUF ), yp_curs, MPI_CHAR, yp, yp, comm, &yp_send ) ;
619    }
620    if ( ym != MPI_PROC_NULL ) {
621      ierr=MPI_Isend ( buffer_for_proc( ym, 0,       RSL_SENDBUF ), ym_curs, MPI_CHAR, ym, ym, comm, &ym_send ) ;
622    }
623    if ( yp != MPI_PROC_NULL ) MPI_Wait( &yp_recv, &stat ) ; 
624    if ( ym != MPI_PROC_NULL ) MPI_Wait( &ym_recv, &stat ) ; 
625    if ( yp != MPI_PROC_NULL ) MPI_Wait( &yp_send, &stat ) ; 
626    if ( ym != MPI_PROC_NULL ) MPI_Wait( &ym_send, &stat ) ;
627  }
628  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
629#else
630fprintf(stderr,"RSL_LITE_EXCH_Y disabled\n") ;
631#endif
632}
633
634RSL_LITE_EXCH_X ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
635{
636  int me, np, np_x, np_y ;
637  int yp, ym, xp, xm ;
638  MPI_Status stat ;
639  MPI_Comm comm, *comm0, dummy_comm ;
640
641  comm0 = &dummy_comm ;
642  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
643#if 1
644  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
645  if ( np_x > 1 ) {
646    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
647    if ( xp != MPI_PROC_NULL ) {
648      MPI_Irecv ( buffer_for_proc( xp, xp_curs, RSL_RECVBUF ), xp_curs, MPI_CHAR, xp, me, comm, &xp_recv ) ;
649    }
650    if ( xm != MPI_PROC_NULL ) {
651      MPI_Irecv ( buffer_for_proc( xm, xm_curs, RSL_RECVBUF ), xm_curs, MPI_CHAR, xm, me, comm, &xm_recv ) ;
652    }
653    if ( xp != MPI_PROC_NULL ) {
654      MPI_Isend ( buffer_for_proc( xp, 0,       RSL_SENDBUF ), xp_curs, MPI_CHAR, xp, xp, comm, &xp_send ) ;
655    }
656    if ( xm != MPI_PROC_NULL ) {
657      MPI_Isend ( buffer_for_proc( xm, 0,       RSL_SENDBUF ), xm_curs, MPI_CHAR, xm, xm, comm, &xm_send ) ;
658    }
659    if ( xp != MPI_PROC_NULL ) MPI_Wait( &xp_recv, &stat ) ; 
660    if ( xm != MPI_PROC_NULL ) MPI_Wait( &xm_recv, &stat ) ; 
661    if ( xp != MPI_PROC_NULL ) MPI_Wait( &xp_send, &stat ) ; 
662    if ( xm != MPI_PROC_NULL ) MPI_Wait( &xm_send, &stat ) ;
663  }
664#else
665fprintf(stderr,"RSL_LITE_EXCH_X disabled\n") ;
666#endif
667  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
668}
669
670#include <sys/time.h>
671RSL_INTERNAL_MILLICLOCK ()
672{
673    struct timeval tb ;
674    struct timezone tzp ;
675    int isec ;  /* seconds */
676    int usec ;  /* microseconds */
677    int msecs ;
678    gettimeofday( &tb, &tzp ) ;
679    isec = tb.tv_sec ;
680    usec = tb.tv_usec ;
681    msecs = 1000 * isec + usec / 1000 ;
682    return(msecs) ;
683}
684RSL_INTERNAL_MICROCLOCK ()
685{
686    struct timeval tb ;
687    struct timezone tzp ;
688    int isec ;  /* seconds */
689    int usec ;  /* microseconds */
690    int msecs ;
691    gettimeofday( &tb, &tzp ) ;
692    isec = tb.tv_sec ;
693    usec = tb.tv_usec ;
694    msecs = 1000000 * isec + usec ;
695    return(msecs) ;
696}
Note: See TracBrowser for help on using the repository browser.