wrfv2_fire/external/RSL_LITE/rsl_bcast.c

   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
  69 typedef struct bcast_point_desc {
  70   int ig ;
  71   int jg ;
  72 } bcast_point_desc_t ;
  73
  74
  75 static destroy_par_info ( p )
  76   char * p ;
  77 {
  78   if ( p != NULL ) RSL_FREE( p ) ;
  79 }
  80
  81 static rsl_list_t *Xlist, *Xp, *Xprev ;
  82 static rsl_list_t *stage ;
  83 static int stage_len = 0 ;              /* 96/3/15 */
  84
  85 static int  Sendbufsize ;
  86 static int  Sendbufcurs ;
  87 static char *Sendbuf ;
  88 static int  Sdisplacements[RSL_MAXPROC] ;
  89 static int  Ssizes[RSL_MAXPROC] ;
  90
  91 static int  Recsizeindex ;
  92
  93 static int  Rbufsize ;
  94 static int  Rbufcurs ;
  95 static int  Rpointcurs ;
  96 static char *Recvbuf ;
  97 static int  Rdisplacements[RSL_MAXPROC+1] ;
  98 static int  Rsizes[RSL_MAXPROC] ;
  99 static int  Rreclen ;
 100
 101 static int s_d ;
 102 static int s_nst ;
 103 static int s_msize ;
 104 static int s_idim ;
 105 static int s_jdim ;
 106 static int s_idim_nst ;
 107 static int s_jdim_nst ;
 108 static int s_irax_n ;
 109 static int s_irax_m ;
 110 static int s_ntasks_x ;
 111 static int s_ntasks_y ;
 112 static rsl_list_t **Plist ;
 113 static int Psize[RSL_MAXPROC] ;
 114 static char *s_parent_msgs ;
 115 static int s_parent_msgs_curs ;
 116 static 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
 123 static int s_i, s_j, s_ig, s_jg, s_cm, s_cn,
 124            s_nig, s_njg ;
 125
 126 static int Pcurs ;
 127 static rsl_list_t *Pptr ;
 128
 129 #ifdef LEARN_BCAST
 130 static int s_putmsg = 0 ;
 131 #endif
 132
 133 /* parent->nest */
 134 RSL_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 */
 265 RSL_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 */
 391 RSL_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 */
 401 RSL_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 */
 411 rsl_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 */
 454 RSL_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 */
 468 RSL_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 */
 482 rsl_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     Rbufsize += Rsizes[P] ;
 537   }
 538
 539   /* this will be freed later */
 540
 541   Recvbuf = RSL_MALLOC( char , Rbufsize + 3 * sizeof(int) ) ; /* for sentinal record */
 542   Rbufcurs = 0 ;
 543   Rreclen = 0 ;
 544
 545 #ifndef STUBMPI
 546   rc = MPI_Alltoallv ( Sendbuf, Ssizes, Sdisplacements, MPI_BYTE ,
 547                        Recvbuf, Rsizes, Rdisplacements, MPI_BYTE ,  comm ) ;
 548 #else
 549   work = Sendbuf ;
 550   Sendbuf = Recvbuf ;
 551   Recvbuf = work ;
 552 #endif
 553
 554 /* add sentinel to the end of Recvbuf */
 555
 556   r = (int *)&(Recvbuf[Rbufsize + 2 * sizeof(int)]) ;
 557   *r = RSL_INVALID ;
 558
 559   RSL_FREE( Sendbuf ) ;
 560   RSL_FREE( Psize_all ) ;
 561
 562   for ( j = 0 ; j < *ntasks_p ; j++ )  {
 563     destroy_list ( &(Plist[j]), NULL ) ;
 564   }
 565   RSL_FREE( Plist ) ;
 566   Plist = NULL ;
 567
 568 }
 569
 570 /********************************************/
 571
 572 /* parent->nest */
 573 RSL_LITE_FROM_PARENT_INFO ( ig_p, jg_p, retval_p )
 574   int_p
 575     ig_p        /* (O) Global index in M dimension of nest. */
 576    ,jg_p        /* (O) Global index in N dimension of nest. */
 577    ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
 578 {
 579   rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p ) ;
 580 }
 581
 582 /* nest->parent */
 583 RSL_LITE_FROM_CHILD_INFO ( ig_p, jg_p, retval_p )
 584   int_p
 585     ig_p        /* (O) Global index in M dimension of nest. */
 586    ,jg_p        /* (O) Global index in N dimension of nest. */
 587    ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
 588 {
 589   rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p ) ;
 590 }
 591
 592 /* common code */
 593 rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p )
 594   int_p
 595     ig_p        /* (O) Global index in M dimension of nest. */
 596    ,jg_p        /* (O) Global index in N dimension of nest. */
 597    ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
 598 {
 599   int ii ;
 600
 601   Rbufcurs = Rbufcurs + Rreclen ;
 602   Rpointcurs = 0 ;
 603   *ig_p    = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
 604   *jg_p    = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
 605 /* read sentinel */
 606   Rreclen  = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
 607   *retval_p = 1 ;
 608   if ( Rreclen == RSL_INVALID ) {
 609     *retval_p = 0 ;
 610     RSL_FREE( Recvbuf ) ;
 611   }
 612
 613   return ;
 614 }
 615
 616 /********************************************/
 617
 618 /* parent->nest */
 619 RSL_LITE_FROM_PARENT_MSG ( len_p, buf )
 620   int_p
 621     len_p ;          /* (I) Number of bytes to unpack. */
 622   int *
 623     buf ;            /* (O) Destination buffer. */
 624 {
 625   rsl_lite_from_peerpoint_msg ( len_p, buf ) ;
 626 }
 627
 628 /* nest->parent */
 629 RSL_LITE_FROM_CHILD_MSG ( len_p, buf )
 630   int_p
 631     len_p ;          /* (I) Number of bytes to unpack. */
 632   int *
 633     buf ;            /* (O) Destination buffer. */
 634 {
 635   rsl_lite_from_peerpoint_msg ( len_p, buf ) ;
 636 }
 637
 638 /* common code */
 639 rsl_lite_from_peerpoint_msg ( len_p, buf )
 640   int_p
 641     len_p ;          /* (I) Number of bytes to unpack. */
 642   int *
 643     buf ;            /* (O) Destination buffer. */
 644 {
 645   int *p, *q ;
 646   char *c, *d ;
 647   int i ;
 648
 649   if ( *len_p % sizeof(int) == 0 ) {
 650     for ( p = (int *)&(Recvbuf[Rbufcurs+Rpointcurs]), q = buf , i = 0 ; i < *len_p ; i += sizeof(int) )
 651     {
 652       *q++ = *p++ ;
 653     }
 654   } else {
 655     for ( c = &(Recvbuf[Rbufcurs+Rpointcurs]), d = (char *) buf , i = 0 ; i < *len_p ; i++ )
 656     {
 657       *d++ = *c++ ;
 658     }
 659   }
 660
 661   Rpointcurs += *len_p ;
 662 }
 663
 664 /********************************************/
 665
 666 destroy_list( list, dfcn )
 667   rsl_list_t ** list ;          /* pointer to pointer to list */
 668   int (*dfcn)() ;               /* pointer to function for destroying
 669                                    the data field of the list */
 670 {
 671   rsl_list_t *p, *trash ;
 672   if ( list == NULL ) return(0) ;
 673   if ( *list == NULL ) return(0) ;
 674   for ( p = *list ; p != NULL ; )
 675   {
 676     if ( dfcn != NULL ) (*dfcn)( p->data ) ;
 677     trash = p ;
 678     p = p->next ;
 679     RSL_FREE( trash ) ;
 680   }
 681   *list = NULL ;
 682   return(0) ;
 683 }
 684
 685 /********************************************/