source: lmdz_wrf/trunk/WRFV3/external/RSL_LITE/rsl_bcast.c @ 1361

Last change on this file since 1361 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

  • Property svn:executable set to *
File size: 19.5 KB
Line 
1/* #define LEARN_BCAST */
2/***********************************************************************
3     
4                              COPYRIGHT
5     
6     The following is a notice of limited availability of the code and
7     Government license and disclaimer which must be included in the
8     prologue of the code and in all source listings of the code.
9     
10     Copyright notice
11       (c) 1977  University of Chicago
12     
13     Permission is hereby granted to use, reproduce, prepare
14     derivative works, and to redistribute to others at no charge.  If
15     you distribute a copy or copies of the Software, or you modify a
16     copy or copies of the Software or any portion of it, thus forming
17     a work based on the Software and make and/or distribute copies of
18     such work, you must meet the following conditions:
19     
20          a) If you make a copy of the Software (modified or verbatim)
21             it must include the copyright notice and Government       
22             license and disclaimer.
23     
24          b) You must cause the modified Software to carry prominent   
25             notices stating that you changed specified portions of   
26             the Software.
27     
28     This software was authored by:
29     
30     Argonne National Laboratory
31     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
32     Mathematics and Computer Science Division
33     Argonne National Laboratory, Argonne, IL  60439
34     
35     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES
36     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT,
37     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A
38     CONTRACT WITH THE DEPARTMENT OF ENERGY.
39     
40                      GOVERNMENT LICENSE AND DISCLAIMER
41     
42     This computer code material was prepared, in part, as an account
43     of work sponsored by an agency of the United States Government.
44     The Government is granted for itself and others acting on its
45     behalf a paid-up, nonexclusive, irrevocable worldwide license in
46     this data to reproduce, prepare derivative works, distribute
47     copies to the public, perform publicly and display publicly, and
48     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT
49     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF
50     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR
51     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY,
52     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS,
53     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD
54     NOT INFRINGE PRIVATELY OWNED RIGHTS.
55
56***************************************************************************/
57
58#define MOD_9707
59
60#ifndef MS_SUA
61# include <stdio.h>
62#endif
63#include <stdlib.h>
64#ifndef STUBMPI
65#  include "mpi.h"
66#endif
67#include "rsl_lite.h"
68
69typedef struct bcast_point_desc {
70  int ig ;
71  int jg ;
72} bcast_point_desc_t ;
73
74
75static destroy_par_info ( p )
76  char * p ;
77{
78  if ( p != NULL ) RSL_FREE( p ) ;
79}
80
81static rsl_list_t *Xlist, *Xp, *Xprev ;
82static rsl_list_t *stage ;
83static int stage_len = 0 ;              /* 96/3/15 */
84
85static int  Sendbufsize ;
86static int  Sendbufcurs ;
87static char *Sendbuf ;
88static int  Sdisplacements[RSL_MAXPROC] ;
89static int  Ssizes[RSL_MAXPROC] ;
90
91static int  Recsizeindex ;
92
93static int  Rbufsize ;
94static int  Rbufcurs ;
95static int  Rpointcurs ;
96static char *Recvbuf ;
97static int  Rdisplacements[RSL_MAXPROC+1] ;
98static int  Rsizes[RSL_MAXPROC] ;
99static int  Rreclen ;
100
101static int s_d ;
102static int s_nst ;
103static int s_msize ;
104static int s_idim ;
105static int s_jdim ;
106static int s_idim_nst ;
107static int s_jdim_nst ;
108static int s_irax_n ;
109static int s_irax_m ;
110static int s_ntasks_x ;
111static int s_ntasks_y ;
112static rsl_list_t **Plist ;
113static int Psize[RSL_MAXPROC] ;
114static char *s_parent_msgs ;
115static int s_parent_msgs_curs ;
116static int s_remaining ;  /* number of bytes left in a parent message before
117                           the next point descriptor */
118
119/* add a field to a message outgoing for the specified child domain cell */
120/* relies on rsl_ready_bcast having been called already */
121/* sends are specified in terms of coarse domain */
122
123static int s_i, s_j, s_ig, s_jg, s_cm, s_cn,
124           s_nig, s_njg ;
125
126static int Pcurs ;
127static rsl_list_t *Pptr ; 
128
129#ifdef LEARN_BCAST
130static int s_putmsg = 0 ;
131#endif
132
133/* parent->nest */
134RSL_LITE_TO_CHILD_INFO ( Fcomm, msize_p,
135                         cips_p, cipe_p, cjps_p, cjpe_p, /* patch dims of SOURCE DOMAIN */
136                         iids_p, iide_p, ijds_p, ijde_p, /* domain dims of INTERMEDIATE DOMAIN */
137                         nids_p, nide_p, njds_p, njde_p, /* domain dims of CHILD DOMAIN */
138                         pgr_p,  shw_p ,                 /* nest ratio and stencil half width */
139                         ntasks_x_p , ntasks_y_p ,       /* proc counts in x and y */
140                         min_subdomain ,                 /* minimum width allowed for a subdomain in a dim ON PARENT */
141                         icoord_p, jcoord_p,
142                         idim_cd_p, jdim_cd_p,
143                         ig_p, jg_p,
144                         retval_p )
145 
146  int_p
147     Fcomm                            /* Fortran version of MPI communicator */
148    ,cips_p, cipe_p, cjps_p, cjpe_p   /* (i) c.d. patch dims */
149    ,iids_p, iide_p, ijds_p, ijde_p   /* (i) n.n. global dims */
150    ,nids_p, nide_p, njds_p, njde_p   /* (i) n.n. global dims */
151    ,pgr_p                            /* nesting ratio */
152    ,ntasks_x_p , ntasks_y_p          /* proc counts in x and y */
153    ,min_subdomain
154    ,icoord_p       /* i coordinate of nest in cd */
155    ,jcoord_p       /* j coordinate of nest in cd */
156    ,shw_p          /* stencil half width */
157    ,idim_cd_p      /* i width of nest in cd */
158    ,jdim_cd_p      /* j width of nest in cd */
159    ,msize_p        /* (I) Message size in bytes. */
160    ,ig_p           /* (O) Global N index of parent domain point. */
161    ,jg_p           /* (O) Global N index of parent domain point. */
162    ,retval_p ;     /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
163{
164  int P, Px, Py ;
165
166  rsl_list_t *q ;
167  int *r ;
168  int i, j, ni, nj ;
169  int coords[2] ;
170  int ierr ;
171#ifndef STUBMPI
172  MPI_Comm *comm, dummy_comm ;
173
174  comm = &dummy_comm ;
175  *comm = MPI_Comm_f2c( *Fcomm ) ;
176#endif
177
178  if ( Plist == NULL ) {
179    s_ntasks_x = *ntasks_x_p ;
180    s_ntasks_y = *ntasks_y_p ;
181    /* construct Plist */
182    Sendbufsize = 0 ;
183    Plist = RSL_MALLOC( rsl_list_t * , s_ntasks_x * s_ntasks_y ) ;  /* big enough for nest points */
184    for ( j = 0 ; j < s_ntasks_x * s_ntasks_y ; j++ ) {
185       Plist[j] = NULL ;
186       Sdisplacements[j] = 0 ;
187       Ssizes[j] = 0 ;
188    }
189    ierr = 0 ;
190    for ( j = *cjps_p ; j <= *cjpe_p ; j++ )
191    {
192      for ( i = *cips_p ; i <= *cipe_p ; i++ )
193      {
194        if ( ( *jcoord_p <= j && j <= *jcoord_p+*jdim_cd_p-1 ) && ( *icoord_p <= i && i <= *icoord_p+*idim_cd_p-1 ) ) {
195           ni = ( i - (*icoord_p + *shw_p) ) * *pgr_p + 1 + 1 ; /* add 1 to give center point */
196           nj = ( j - (*jcoord_p + *shw_p) ) * *pgr_p + 1 + 1 ;
197
198#ifndef STUBMPI
199           TASK_FOR_POINT ( &ni, &nj, nids_p, nide_p, njds_p, njde_p, &s_ntasks_x, &s_ntasks_y, &Px, &Py, 
200                            min_subdomain, min_subdomain, &ierr ) ;
201           coords[1] = Px ; coords[0] = Py ;
202           MPI_Cart_rank( *comm, coords, &P ) ;
203#else
204           P = 0 ;
205#endif
206           q = RSL_MALLOC( rsl_list_t , 1 ) ;
207           q->info1 = i ;
208           q->info2 = j ;
209           q->next = Plist[P] ;
210           Plist[P] = q ;
211           Sendbufsize += *msize_p + 3 * sizeof( int ) ;  /* point data plus 3 ints for i, j, and size */
212        }
213      }
214    }
215    if ( ierr != 0 ) {
216      fprintf(stderr,"rsl_to_child_info: ") ;
217      TASK_FOR_POINT_MESSAGE () ;
218    }
219    Sendbuf = RSL_MALLOC( char , Sendbufsize ) ;
220    Sendbufcurs = 0 ;
221    Recsizeindex = -1 ;
222    Pcurs = -1 ;
223    Pptr = NULL ;
224  }
225
226  if ( Pptr != NULL ) {
227    Pptr = Pptr->next ;
228  } 
229
230  if ( Recsizeindex >= 0 ) {
231          r = (int *) &(Sendbuf[Recsizeindex]) ;
232          *r = Sendbufcurs - Recsizeindex + 2 * sizeof(int) ;
233          Ssizes[Pcurs] += *r ;
234  }
235
236  while ( Pptr == NULL ) {
237      Pcurs++ ;
238      while ( Pcurs < s_ntasks_x * s_ntasks_y && Plist[Pcurs] == NULL  ) Pcurs++ ;
239      if ( Pcurs < s_ntasks_x * s_ntasks_y ) {
240        Sdisplacements[Pcurs] = Sendbufcurs ;
241        Ssizes[Pcurs] = 0 ;
242        Pptr = Plist[Pcurs] ;
243      } else {
244        *retval_p = 0 ;
245        return ;  /* done */
246      }
247  }
248
249  *ig_p = Pptr->info1 ;
250  *jg_p = Pptr->info2 ;
251
252  r = (int *) &(Sendbuf[Sendbufcurs]) ;
253  *r++ = Pptr->info1 ; Sendbufcurs += sizeof(int) ;  /* ig to buffer */
254  *r++ = Pptr->info2 ; Sendbufcurs += sizeof(int) ;  /* jg to buffer */
255  Recsizeindex = Sendbufcurs ;
256  *r++ =           0 ; Sendbufcurs += sizeof(int) ;  /* store start for size */
257  *retval_p = 1 ;
258
259  return ;
260}
261
262/********************************************/
263
264/* nest->parent */
265RSL_LITE_TO_PARENT_INFO ( Fcomm, msize_p,
266                          nips_p, nipe_p, njps_p, njpe_p, /* patch dims of SOURCE DOMAIN (CHILD) */
267                          cids_p, cide_p, cjds_p, cjde_p, /* domain dims of TARGET DOMAIN (PARENT) */
268                          ntasks_x_p , ntasks_y_p ,       /* proc counts in x and y */
269                          min_subdomain ,
270                          icoord_p, jcoord_p,
271                          idim_cd_p, jdim_cd_p,
272                          ig_p, jg_p,
273                          retval_p )
274  int_p
275     Fcomm                            /* Fortran version of MPI communicator */
276    ,nips_p, nipe_p, njps_p, njpe_p   /* (i) n.d. patch dims */
277    ,cids_p, cide_p, cjds_p, cjde_p   /* (i) n.n. global dims */
278    ,ntasks_x_p , ntasks_y_p          /* proc counts in x and y */
279    ,min_subdomain
280    ,icoord_p       /* i coordinate of nest in cd */
281    ,jcoord_p       /* j coordinate of nest in cd */
282    ,idim_cd_p      /* i width of nest in cd */
283    ,jdim_cd_p      /* j width of nest in cd */
284    ,msize_p        /* (I) Message size in bytes. */
285    ,ig_p           /* (O) Global N index of parent domain point. */
286    ,jg_p           /* (O) Global N index of parent domain point. */
287    ,retval_p ;     /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
288{
289  int P, Px, Py ;
290  rsl_list_t *q ;
291  int *r ;
292  int i, j ;
293  int coords[2] ;
294  int ierr ;
295#ifndef STUBMPI
296  MPI_Comm *comm, dummy_comm ;
297
298  comm = &dummy_comm ;
299  *comm = MPI_Comm_f2c( *Fcomm ) ;
300#endif
301
302  if ( Plist == NULL ) {
303    s_ntasks_x = *ntasks_x_p ;
304    s_ntasks_y = *ntasks_y_p ;
305    /* construct Plist */
306    Sendbufsize = 0 ;
307    Plist = RSL_MALLOC( rsl_list_t * , s_ntasks_x * s_ntasks_y ) ;
308    for ( j = 0 ; j < s_ntasks_x * s_ntasks_y ; j++ ) {
309       Plist[j] = NULL ;
310       Sdisplacements[j] = 0 ;
311       Ssizes[j] = 0 ;
312    }
313    ierr = 0 ;
314    for ( j = *njps_p ; j <= *njpe_p ; j++ )
315    {
316      for ( i = *nips_p ; i <= *nipe_p ; i++ )
317      {
318        if ( ( *jcoord_p <= j && j <= *jcoord_p+*jdim_cd_p-1 ) && ( *icoord_p <= i && i <= *icoord_p+*idim_cd_p-1 ) ) {
319#ifndef STUBMPI
320          TASK_FOR_POINT ( &i, &j, cids_p, cide_p, cjds_p, cjde_p, &s_ntasks_x, &s_ntasks_y, &Px, &Py, 
321                           min_subdomain, min_subdomain, &ierr ) ;
322          coords[1] = Px ; coords[0] = Py ;
323          MPI_Cart_rank( *comm, coords, &P ) ;
324#else
325          P = 0 ;
326#endif
327          q = RSL_MALLOC( rsl_list_t , 1 ) ;
328          q->info1 = i ;
329          q->info2 = j ;
330          q->next = Plist[P] ;
331          Plist[P] = q ;
332          Sendbufsize += *msize_p + 3 * sizeof( int ) ;  /* point data plus 3 ints for i, j, and size */
333        }
334      }
335    }
336    if ( ierr != 0 ) {
337      fprintf(stderr,"rsl_to_parent_info: ") ;
338      TASK_FOR_POINT_MESSAGE () ;
339    }
340    Sendbuf = RSL_MALLOC( char , Sendbufsize ) ;
341    Sendbufcurs = 0 ;
342    Recsizeindex = -1 ;
343    Pcurs = -1 ;
344    Pptr = NULL ;
345  }
346  if ( Pptr != NULL ) {
347    Pptr = Pptr->next ;
348  } 
349
350  if ( Recsizeindex >= 0 ) {
351          r = (int *) &(Sendbuf[Recsizeindex]) ;
352          *r = Sendbufcurs - Recsizeindex + 2 * sizeof(int) ;
353          Ssizes[Pcurs] += *r ;
354  }
355
356  while ( Pptr == NULL ) {
357      Pcurs++ ;
358      while ( Pcurs < s_ntasks_x * s_ntasks_y && Plist[Pcurs] == NULL ) Pcurs++ ;
359      if ( Pcurs < s_ntasks_x * s_ntasks_y ) {
360        Sdisplacements[Pcurs] = Sendbufcurs ;
361        Ssizes[Pcurs] = 0 ;
362        Pptr = Plist[Pcurs] ;
363      } else {
364        *retval_p = 0 ;
365        return ;  /* done */
366      }
367  }
368
369  *ig_p = Pptr->info1 ;
370  *jg_p = Pptr->info2 ;
371
372  r = (int *) &(Sendbuf[Sendbufcurs]) ;
373  *r++ = Pptr->info1 ; Sendbufcurs += sizeof(int) ;  /* ig to buffer */
374  *r++ = Pptr->info2 ; Sendbufcurs += sizeof(int) ;  /* jg to buffer */
375  Recsizeindex = Sendbufcurs ;
376  *r++ =           0 ; Sendbufcurs += sizeof(int) ;  /* store start for size */
377  *retval_p = 1 ;
378
379  return ;
380}
381
382
383/********************************************/
384
385/*@
386  RSL_TO_CHILD_MSG -- Pack force data into a message for a nest point.
387
388@*/
389
390/* parent->nest */
391RSL_LITE_TO_CHILD_MSG ( nbuf_p, buf )
392  int_p
393    nbuf_p ;     /* (I) Number of bytes to be packed. */
394  char *
395    buf ;        /* (I) Buffer containing the data to be packed. */
396{
397   rsl_lite_to_peerpoint_msg ( nbuf_p, buf ) ;
398}
399
400/* nest->parent */
401RSL_LITE_TO_PARENT_MSG ( nbuf_p, buf )
402  int_p
403    nbuf_p ;     /* (I) Number of bytes to be packed. */
404  char *
405    buf ;        /* (I) Buffer containing the data to be packed. */
406{
407   rsl_lite_to_peerpoint_msg ( nbuf_p, buf ) ;
408}
409
410/* common code */
411rsl_lite_to_peerpoint_msg ( nbuf_p, buf )
412  int_p
413    nbuf_p ;     /* (I) Number of bytes to be packed. */
414  char *
415    buf ;        /* (I) Buffer containing the data to be packed. */
416{
417  int nbuf ;
418  int *p, *q ;
419  char *c, *d ;
420  int i ;
421  char mess[4096] ;
422
423  RSL_TEST_ERR(buf==NULL,"2nd argument is NULL.  Field allocated?") ;
424
425  nbuf = *nbuf_p ;
426
427  if ( Sendbufcurs + nbuf >= Sendbufsize ) {
428    sprintf(mess,"RSL_LITE_TO_CHILD_MSG: Sendbufcurs + nbuf (%d) would exceed Sendbufsize (%d)\n",
429           Sendbufcurs + nbuf , Sendbufsize ) ;
430    RSL_TEST_ERR(1,mess) ;
431  }
432
433  if ( nbuf % sizeof(int) == 0 ) {
434    for ( p = (int *)buf, q = (int *) &(Sendbuf[Sendbufcurs]), i = 0 ; i < nbuf ; i += sizeof(int) )
435    {
436      *q++ = *p++ ;
437    }
438  }
439  else
440  {
441    for ( c = buf, d = &(Sendbuf[Sendbufcurs]), i = 0 ; i < nbuf ; i++ )
442    {
443      *d++ = *c++ ;
444    }
445  }
446
447  Sendbufcurs += nbuf ;
448
449}
450
451/********************************************/
452
453/* parent->nest */
454RSL_LITE_BCAST_MSGS ( mytask_p, ntasks_p, Fcomm )
455  int_p mytask_p, ntasks_p, Fcomm ;
456{
457#ifndef STUBMPI
458  MPI_Comm comm ;
459
460  comm = MPI_Comm_f2c( *Fcomm ) ;
461#else
462  int comm ;
463#endif
464  rsl_lite_allgather_msgs ( mytask_p, ntasks_p, comm ) ;
465}
466
467/* nest->parent */
468RSL_LITE_MERGE_MSGS ( mytask_p, ntasks_p, Fcomm )
469  int_p mytask_p, ntasks_p, Fcomm ;
470{
471#ifndef STUBMPI
472  MPI_Comm comm ;
473
474  comm = MPI_Comm_f2c( *Fcomm ) ;
475#else
476  int comm ;
477#endif
478  rsl_lite_allgather_msgs ( mytask_p, ntasks_p, comm ) ;
479}
480
481/* common code */
482rsl_lite_allgather_msgs ( mytask_p, ntasks_p, comm )
483  int_p mytask_p, ntasks_p ;
484#ifndef STUBMPI
485  MPI_Comm comm ;
486#else
487  int comm ;
488#endif
489{
490  int P ;
491  char *work ;
492  int * r ;
493  bcast_point_desc_t pdesc ;
494  int curs ;
495  int msglen, mdest, mtag ;
496  int ntasks, mytask ;
497  int ii, i, j ;
498  int ig, jg ;
499  int *Psize_all ;
500  int *sp, *bp ;
501  int rc ;
502
503#ifndef STUBMPI
504  ntasks = *ntasks_p ;
505  mytask = *mytask_p ;
506#else
507  ntasks = 1 ;
508  mytask = 0 ;
509#endif
510
511  RSL_TEST_ERR( Plist == NULL,
512    "RSL_BCAST_MSGS: rsl_to_child_info not called first" ) ;
513
514  RSL_TEST_ERR( ntasks == RSL_MAXPROC ,
515    "RSL_BCAST_MSGS: raise the compile time value of MAXPROC" ) ;
516 
517  Psize_all = RSL_MALLOC( int, ntasks * ntasks ) ;
518
519#ifndef STUBMPI
520  MPI_Allgather( Ssizes, ntasks, MPI_INT , Psize_all, ntasks, MPI_INT, comm ) ;
521#else
522  Psize_all[0] = Ssizes[0] ;
523#endif
524
525  for ( j = 0 ; j < ntasks ; j++ ) 
526    Rsizes[j] = 0 ;
527
528  for ( j = 0 ; j < ntasks ; j++ ) 
529  {
530    Rsizes[j] += Psize_all[ INDEX_2( j , mytask , ntasks ) ] ;
531  }
532
533  for ( Rbufsize = 0, P = 0, Rdisplacements[0] = 0 ; P < ntasks ; P++ )
534  {
535    Rdisplacements[P+1] = Rsizes[P] + Rdisplacements[P] ;
536
537    Rbufsize += Rsizes[P] ;
538  }
539
540  /* this will be freed later */
541
542  Recvbuf = RSL_MALLOC( char , Rbufsize + 3 * sizeof(int) ) ; /* for sentinal record */
543  Rbufcurs = 0 ;
544  Rreclen = 0 ;
545
546#ifndef STUBMPI
547  rc = MPI_Alltoallv ( Sendbuf, Ssizes, Sdisplacements, MPI_BYTE , 
548                       Recvbuf, Rsizes, Rdisplacements, MPI_BYTE ,  comm ) ;
549#else
550  work = Sendbuf ;
551  Sendbuf = Recvbuf ;
552  Recvbuf = work ;
553#endif
554
555/* add sentinel to the end of Recvbuf */
556
557  r = (int *)&(Recvbuf[Rbufsize + 2 * sizeof(int)]) ;
558  *r = RSL_INVALID ;
559
560  RSL_FREE( Sendbuf ) ;
561  RSL_FREE( Psize_all ) ;
562
563  for ( j = 0 ; j < *ntasks_p ; j++ )  {
564    destroy_list ( &(Plist[j]), NULL ) ;
565  }
566  RSL_FREE( Plist ) ;
567  Plist = NULL ;
568
569}
570
571/********************************************/
572
573/* parent->nest */
574RSL_LITE_FROM_PARENT_INFO ( ig_p, jg_p, retval_p )
575  int_p
576    ig_p        /* (O) Global index in M dimension of nest. */
577   ,jg_p        /* (O) Global index in N dimension of nest. */
578   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
579{
580  rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p ) ;
581}
582
583/* nest->parent */
584RSL_LITE_FROM_CHILD_INFO ( ig_p, jg_p, retval_p )
585  int_p
586    ig_p        /* (O) Global index in M dimension of nest. */
587   ,jg_p        /* (O) Global index in N dimension of nest. */
588   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
589{
590  rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p ) ;
591}
592
593/* common code */
594rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p )
595  int_p
596    ig_p        /* (O) Global index in M dimension of nest. */
597   ,jg_p        /* (O) Global index in N dimension of nest. */
598   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
599{
600  int ii ;
601
602  Rbufcurs = Rbufcurs + Rreclen ;
603  Rpointcurs = 0 ;
604  *ig_p    = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
605  *jg_p    = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
606/* read sentinel */
607  Rreclen  = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
608  *retval_p = 1 ;
609  if ( Rreclen == RSL_INVALID ) {
610    *retval_p = 0 ;
611    RSL_FREE( Recvbuf ) ;
612  }
613     
614  return ;
615}
616
617/********************************************/
618
619/* parent->nest */
620RSL_LITE_FROM_PARENT_MSG ( len_p, buf )
621  int_p
622    len_p ;          /* (I) Number of bytes to unpack. */
623  int *
624    buf ;            /* (O) Destination buffer. */
625{
626  rsl_lite_from_peerpoint_msg ( len_p, buf ) ;
627}
628
629/* nest->parent */
630RSL_LITE_FROM_CHILD_MSG ( len_p, buf )
631  int_p
632    len_p ;          /* (I) Number of bytes to unpack. */
633  int *
634    buf ;            /* (O) Destination buffer. */
635{
636  rsl_lite_from_peerpoint_msg ( len_p, buf ) ;
637}
638
639/* common code */
640rsl_lite_from_peerpoint_msg ( len_p, buf )
641  int_p
642    len_p ;          /* (I) Number of bytes to unpack. */
643  int *
644    buf ;            /* (O) Destination buffer. */
645{
646  int *p, *q ;
647  char *c, *d ;
648  int i ;
649
650  if ( *len_p % sizeof(int) == 0 ) {
651    for ( p = (int *)&(Recvbuf[Rbufcurs+Rpointcurs]), q = buf , i = 0 ; i < *len_p ; i += sizeof(int) ) 
652    {
653      *q++ = *p++ ;
654    }
655  } else {
656    for ( c = &(Recvbuf[Rbufcurs+Rpointcurs]), d = (char *) buf , i = 0 ; i < *len_p ; i++ )
657    {
658      *d++ = *c++ ;
659    }
660  }
661
662  Rpointcurs += *len_p ;
663}
664
665/********************************************/
666
667destroy_list( list, dfcn )
668  rsl_list_t ** list ;          /* pointer to pointer to list */
669  int (*dfcn)() ;               /* pointer to function for destroying
670                                   the data field of the list */
671{
672  rsl_list_t *p, *trash ;
673  if ( list == NULL ) return(0) ;
674  if ( *list == NULL ) return(0) ;
675  for ( p = *list ; p != NULL ; )
676  {
677    if ( dfcn != NULL ) (*dfcn)( p->data ) ;
678    trash = p ;
679    p = p->next ;
680    RSL_FREE( trash ) ;
681  }
682  *list = NULL ;
683  return(0) ;
684}
685
686/********************************************/
Note: See TracBrowser for help on using the repository browser.