Statistiques
| Révision :

root / src / comm / HPL_blonM.c @ 1

Historique | Voir | Annoter | Télécharger (15,47 ko)

1
/* 
2
 * -- High Performance Computing Linpack Benchmark (HPL)                
3
 *    HPL - 2.0 - September 10, 2008                          
4
 *    Antoine P. Petitet                                                
5
 *    University of Tennessee, Knoxville                                
6
 *    Innovative Computing Laboratory                                 
7
 *    (C) Copyright 2000-2008 All Rights Reserved                       
8
 *                                                                      
9
 * -- Copyright notice and Licensing terms:                             
10
 *                                                                      
11
 * Redistribution  and  use in  source and binary forms, with or without
12
 * modification, are  permitted provided  that the following  conditions
13
 * are met:                                                             
14
 *                                                                      
15
 * 1. Redistributions  of  source  code  must retain the above copyright
16
 * notice, this list of conditions and the following disclaimer.        
17
 *                                                                      
18
 * 2. Redistributions in binary form must reproduce  the above copyright
19
 * notice, this list of conditions,  and the following disclaimer in the
20
 * documentation and/or other materials provided with the distribution. 
21
 *                                                                      
22
 * 3. All  advertising  materials  mentioning  features  or  use of this
23
 * software must display the following acknowledgement:                 
24
 * This  product  includes  software  developed  at  the  University  of
25
 * Tennessee, Knoxville, Innovative Computing Laboratory.             
26
 *                                                                      
27
 * 4. The name of the  University,  the name of the  Laboratory,  or the
28
 * names  of  its  contributors  may  not  be used to endorse or promote
29
 * products  derived   from   this  software  without  specific  written
30
 * permission.                                                          
31
 *                                                                      
32
 * -- Disclaimer:                                                       
33
 *                                                                      
34
 * THIS  SOFTWARE  IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
35
 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,  INCLUDING,  BUT NOT
36
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
37
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY
38
 * OR  CONTRIBUTORS  BE  LIABLE FOR ANY  DIRECT,  INDIRECT,  INCIDENTAL,
39
 * SPECIAL,  EXEMPLARY,  OR  CONSEQUENTIAL DAMAGES  (INCLUDING,  BUT NOT
40
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
41
 * DATA OR PROFITS; OR BUSINESS INTERRUPTION)  HOWEVER CAUSED AND ON ANY
42
 * THEORY OF LIABILITY, WHETHER IN CONTRACT,  STRICT LIABILITY,  OR TORT
43
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
44
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 
45
 * ---------------------------------------------------------------------
46
 */ 
47
/*
48
 * Include files
49
 */
50
#include "hpl.h"
51

    
52
#ifdef HPL_NO_MPI_DATATYPE  /* The user insists to not use MPI types */
53
#ifndef HPL_COPY_L       /* and also want to avoid the copy of L ... */
54
#define HPL_COPY_L   /* well, sorry, can not do that: force the copy */
55
#endif
56
#endif
57

    
58
#define   I_SEND    0
59
#define   I_RECV    1
60

    
61
#ifdef STDC_HEADERS
62
int HPL_binit_blonM
63
(
64
   HPL_T_panel *              PANEL
65
)
66
#else
67
int HPL_binit_blonM( PANEL )
68
   HPL_T_panel *              PANEL;
69
#endif
70
{
71
/* ..
72
 * .. Executable Statements ..
73
 */
74
   if( PANEL == NULL )           { return( HPL_SUCCESS ); }
75
   if( PANEL->grid->npcol <= 1 ) { return( HPL_SUCCESS ); }
76
#ifdef HPL_USE_MPI_DATATYPE
77
#ifdef HPL_COPY_L
78
/*
79
 * Copy the panel into a contiguous buffer
80
 */
81
   HPL_copyL( PANEL );
82
#endif
83
#else
84
/*
85
 * Force the copy of the panel into a contiguous buffer
86
 */
87
   HPL_copyL( PANEL );
88
#endif
89
   return( HPL_SUCCESS );
90
}
91
 
92
#ifdef HPL_USE_MPI_DATATYPE
93
 
94
#define   _M_BUFF_S1        PANEL->buffers[I_SEND]
95
#define   _M_COUNT_S1       PANEL->counts[I_SEND]
96
#define   _M_TYPE_S1        PANEL->dtypes[I_SEND]
97
 
98
#define   _M_BUFF_S2        PANEL->buffers[I_SEND]
99
#define   _M_COUNT_S2       PANEL->counts[I_SEND]
100
#define   _M_TYPE_S2        PANEL->dtypes[I_SEND]
101
 
102
#define   _M_BUFF_R1        PANEL->buffers[I_RECV]
103
#define   _M_COUNT_R1       PANEL->counts[I_RECV]
104
#define   _M_TYPE_R1        PANEL->dtypes[I_RECV]
105

    
106
#define   _M_BUFF_R2        PANEL->buffers[I_RECV]
107
#define   _M_COUNT_R2       PANEL->counts[I_RECV]
108
#define   _M_TYPE_R2        PANEL->dtypes[I_RECV]
109
 
110
#define   _M_ROLL_BUFF_S    PANEL->buffers[I_SEND]
111
#define   _M_ROLL_COUNT_S   PANEL->counts[I_SEND]
112
#define   _M_ROLL_TYPE_S    PANEL->dtypes[I_SEND]
113

    
114
#define   _M_ROLL_BUFF_R    PANEL->buffers[I_RECV]
115
#define   _M_ROLL_COUNT_R   PANEL->counts[I_RECV]
116
#define   _M_ROLL_TYPE_R    PANEL->dtypes[I_RECV]
117

    
118
#else
119

    
120
#define   _M_BUFF_S1        (void *)(PANEL->L2)
121
#define   _M_COUNT_S1       PANEL->len
122
#define   _M_TYPE_S1        MPI_DOUBLE
123

    
124
#define   _M_BUFF_S2        (void *)(PANEL->L2 + ibuf)
125
#define   _M_COUNT_S2       lbuf
126
#define   _M_TYPE_S2        MPI_DOUBLE
127
 
128
#define   _M_BUFF_R1        (void *)(PANEL->L2)
129
#define   _M_COUNT_R1       PANEL->len
130
#define   _M_TYPE_R1        MPI_DOUBLE
131
 
132
#define   _M_BUFF_R2        (void *)(PANEL->L2 + ibuf)
133
#define   _M_COUNT_R2       lbuf
134
#define   _M_TYPE_R2        MPI_DOUBLE
135
 
136
#define   _M_ROLL_BUFF_S    (void *)(PANEL->L2 + ibufS)
137
#define   _M_ROLL_COUNT_S   lbufS
138
#define   _M_ROLL_TYPE_S    MPI_DOUBLE
139
#define   _M_ROLL_BUFF_R    (void *)(PANEL->L2 + ibufR)
140
#define   _M_ROLL_COUNT_R   lbufR
141
#define   _M_ROLL_TYPE_R    MPI_DOUBLE
142

    
143
#endif
144

    
145
#ifdef STDC_HEADERS
146
int HPL_bcast_blonM
147
(
148
   HPL_T_panel                * PANEL,
149
   int                        * IFLAG
150
)
151
#else
152
int HPL_bcast_blonM( PANEL, IFLAG )
153
   HPL_T_panel                * PANEL;
154
   int                        * IFLAG;
155
#endif
156
{ 
157
/*
158
 * .. Local Variables ..
159
 */
160
   MPI_Comm                   comm;
161
   int                        COUNT, count, go=1, ierr=MPI_SUCCESS, ibuf,
162
                              ibufR, ibufS, dummy=0, indx, ip2=1, k, l,
163
                              lbuf, lbufR, lbufS, mask=1, msgid, mydist,
164
                              mydist2, next, npm1, npm2, partner, prev,
165
                              rank, root, size;
166
/* ..
167
 * .. Executable Statements ..
168
 */
169
   if( PANEL == NULL ) { *IFLAG = HPL_SUCCESS; return( HPL_SUCCESS ); }
170
   if( ( size = PANEL->grid->npcol ) <= 1 )
171
   {                     *IFLAG = HPL_SUCCESS; return( HPL_SUCCESS ); }
172
/*
173
 * Cast phase:  root process  sends to its right neighbor,  then spread
174
 * the panel on the other npcol - 2 processes.  If  I  am  not the root 
175
 * process, probe for message received.  If the message is there,  then
176
 * receive it. If I am just after the root process, return.  Otherwise,
177
 * keep spreading on those npcol - 2 processes.  Otherwise,  inform the
178
 * caller that the panel has still not been received.
179
 */
180
   comm = PANEL->grid->row_comm; rank  = PANEL->grid->mycol;
181
   root = PANEL->pcol;           msgid = PANEL->msgid;
182
   prev = MModSub1( rank, size );
183
 
184
   if( rank == root )
185
   {
186
#ifdef HPL_USE_MPI_DATATYPE
187
      if( ierr == MPI_SUCCESS )
188
         ierr =   HPL_packL( PANEL, 0, PANEL->len, I_SEND );
189
#endif
190
      if( ierr == MPI_SUCCESS )
191
         ierr =   MPI_Ssend( _M_BUFF_S1, _M_COUNT_S1, _M_TYPE_S1,
192
                             MModAdd1( rank, size ), msgid, comm );
193
#ifdef HPL_USE_MPI_DATATYPE
194
      if( ierr == MPI_SUCCESS )
195
         ierr =   MPI_Type_free( &PANEL->dtypes[I_SEND] );
196
#endif
197
   }
198
   else if( prev == root )
199
   {
200
/*
201
 * This probing mechanism causes problems when lookhead is on. Too many
202
 * messages are exchanged  in this virtual topology  causing  a hang on
203
 * some machines. It is currently disabled until a better understanding
204
 * is acquired.
205
 *
206
 *    ierr = MPI_Iprobe( root, msgid, comm, &go, &PANEL->status[0] );
207
 */
208
      if( ierr == MPI_SUCCESS )
209
      {                                  /* if panel is here, proceed */
210
         if( go != 0 )
211
         {
212
#ifdef HPL_USE_MPI_DATATYPE
213
            ierr =      HPL_packL( PANEL, 0, PANEL->len, I_RECV );
214
#endif
215
            if( ierr == MPI_SUCCESS )
216
               ierr =   MPI_Recv( _M_BUFF_R1, _M_COUNT_R1, _M_TYPE_R1,
217
                                  root, msgid, comm, &PANEL->status[0] );
218
#ifdef HPL_USE_MPI_DATATYPE
219
            if( ierr == MPI_SUCCESS )
220
               ierr =   MPI_Type_free( &PANEL->dtypes[I_RECV] );
221
#endif
222
         }
223
         else { *IFLAG = HPL_KEEP_TESTING; return( HPL_KEEP_TESTING ); }
224
      }
225
   }
226
/*
227
 * if I am just after the root, exit now. The message receive  completed
228
 * successfully, this guy is done. If there are only 2 processes in each 
229
 * row of processes, we are done as well.
230
 */
231
   if( ( prev == root ) || ( size == 2 ) )
232
   {
233
      *IFLAG = ( ierr == MPI_SUCCESS ? HPL_SUCCESS : HPL_FAILURE );
234
      return( *IFLAG );
235
   }
236
/*
237
 * Otherwise, proceed with broadcast -  Spread  the panel across process
238
 * columns
239
 */
240
   npm2 = ( npm1 = size - 1 ) - 1; COUNT = PANEL->len;
241

    
242
   k = npm2; while( k > 1 ) { k >>= 1; ip2 <<= 1; mask <<= 1; mask++; }
243
   if( rank == root ) mydist2 = ( mydist = 0 );
244
   else   mydist2 = ( mydist  = MModSub( rank, root, size ) - 1 );
245

    
246
   indx = ip2; count = COUNT / npm1; count = Mmax( count, 1 );
247
 
248
   do
249
   {
250
      mask ^= ip2;
251

    
252
      if( ( mydist & mask ) == 0 )
253
      {
254
         lbuf = COUNT - ( ibuf = indx * count );
255
         if( indx + ip2 < npm1 ) { l = ip2 * count; lbuf = Mmin( lbuf, l ); }
256

    
257
         partner = mydist ^ ip2;
258

    
259
         if( ( mydist & ip2 ) != 0 )
260
         {
261
            partner = MModAdd( root, partner, size );
262
            if( partner != root ) partner = MModAdd1( partner, size );  
263
/*
264
 * This probing mechanism causes problems when lookhead is on. Too many
265
 * messages are exchanged  in this virtual topology  causing  a hang on
266
 * some machines. It is currently disabled until a better understanding
267
 * is acquired.
268
 */
269
#if 0
270
            ierr = MPI_Iprobe( partner, msgid, comm, &go, &PANEL->status[0] );
271
  
272
            if( ierr == MPI_SUCCESS )
273
            {        /* if panel is not here, return and keep testing */
274
               if( go == 0 )
275
               { *IFLAG = HPL_KEEP_TESTING; return( HPL_KEEP_TESTING ); }
276
            }
277
#endif
278
            if( lbuf > 0 )
279
            {
280
#ifdef HPL_USE_MPI_DATATYPE
281
               if( ierr == MPI_SUCCESS )
282
                  ierr =   HPL_packL( PANEL, ibuf, lbuf, I_RECV );
283
#endif
284
               if( ierr == MPI_SUCCESS )
285
                  ierr =   MPI_Recv( _M_BUFF_R2, _M_COUNT_R2, _M_TYPE_R2,
286
                                     partner, msgid, comm, &PANEL->status[0] );
287
#ifdef HPL_USE_MPI_DATATYPE
288
               if( ierr == MPI_SUCCESS )
289
                  ierr =   MPI_Type_free( &PANEL->dtypes[I_RECV] );
290
#endif
291
            }
292
            else       /* Recv message of length zero to enable probe */
293
            {
294
               if( ierr == MPI_SUCCESS )
295
                  ierr = MPI_Recv( (void *)(&dummy), 0, MPI_BYTE, partner,
296
                                   msgid, comm, &PANEL->status[0] );
297
            }
298
         }
299
         else if( partner < npm1 )
300
         {
301
            partner = MModAdd( root, partner, size );
302
            if( partner != root ) partner = MModAdd1( partner, size );  
303

    
304
            if( lbuf > 0 )
305
            {
306
#ifdef HPL_USE_MPI_DATATYPE
307
               if( ierr == MPI_SUCCESS )
308
                  ierr =   HPL_packL( PANEL, ibuf, lbuf, I_SEND );
309
#endif
310
               if( ierr == MPI_SUCCESS )
311
                  ierr =   MPI_Ssend( _M_BUFF_S2, _M_COUNT_S2, _M_TYPE_S2,
312
                                      partner, msgid, comm );
313
#ifdef HPL_USE_MPI_DATATYPE
314
               if( ierr == MPI_SUCCESS )
315
                  ierr =   MPI_Type_free( &PANEL->dtypes[I_SEND] );
316
#endif
317
            }
318
            else       /* Recv message of length zero to enable probe */
319
            {
320
               if( ierr == MPI_SUCCESS )
321
                  ierr =   MPI_Ssend( (void *)(&dummy), 0, MPI_BYTE,
322
                                      partner, msgid, comm );
323
            }
324
         }
325
      }
326
 
327
      if( mydist2 < ip2 ) {  ip2 >>= 1; indx -= ip2; }
328
      else { mydist2 -= ip2; ip2 >>= 1; indx += ip2; }
329

    
330
   } while( ip2 > 0 );
331
/*
332
 * Roll the pieces
333
 */
334
   prev = MModSub1( rank, size );
335
   if( MModSub1( prev, size ) == root ) prev = root;
336
   next = MModAdd1( rank, size );
337
   if( rank == root ) next = MModAdd1( next, size );
338

    
339
   for( k = 0; k < npm2; k++ )
340
   {
341
      l = ( k >> 1 );
342
/*
343
 * Who is sending to who and how much
344
 */
345
      if( ( ( mydist + k ) & 1 ) != 0 )
346
      {
347
         ibufS = ( indx = MModAdd( mydist, l,   npm1 ) ) * count;
348
         lbufS = ( indx == npm2 ? COUNT : ibufS + count );
349
         lbufS = Mmin( COUNT, lbufS ) - ibufS; lbufS = Mmax( 0, lbufS );
350

    
351
         ibufR = ( indx = MModSub( mydist, l+1, npm1 ) ) * count;
352
         lbufR = ( indx == npm2 ? COUNT : ibufR + count );
353
         lbufR = Mmin( COUNT, lbufR ) - ibufR; lbufR = Mmax( 0, lbufR );
354

    
355
         partner = prev;
356
      }
357
      else
358
      {
359
         ibufS = ( indx = MModSub( mydist, l,   npm1 ) ) * count;
360
         lbufS = ( indx == npm2 ? COUNT : ibufS + count );
361
         lbufS = Mmin( COUNT, lbufS ) - ibufS; lbufS = Mmax( 0, lbufS );
362

    
363
         ibufR = ( indx = MModAdd( mydist, l+1, npm1 ) ) * count;
364
         lbufR = ( indx == npm2 ? COUNT : ibufR + count );
365
         lbufR = Mmin( COUNT, lbufR ) - ibufR; lbufR = Mmax( 0, lbufR );
366

    
367
         partner = next;
368
      }
369
/*
370
 * Exchange the messages
371
 */
372
      if( lbufS > 0 )
373
      {
374
#ifdef HPL_USE_MPI_DATATYPE
375
         if( ierr == MPI_SUCCESS )
376
            ierr =   HPL_packL( PANEL, ibufS, lbufS, I_SEND );
377
#endif
378
         if( ierr == MPI_SUCCESS )
379
            ierr =   MPI_Issend( _M_ROLL_BUFF_S, _M_ROLL_COUNT_S,
380
                                 _M_ROLL_TYPE_S, partner, msgid, comm,
381
                                 &PANEL->request[0] );
382
      }
383
      else
384
      {
385
         if( ierr == MPI_SUCCESS )
386
            ierr =   MPI_Issend( (void *)(&dummy), 0, MPI_BYTE, partner,
387
                                 msgid, comm, &PANEL->request[0] );
388
      }
389
 
390
      if(  lbufR > 0 )
391
      {
392
#ifdef HPL_USE_MPI_DATATYPE
393
         if( ierr == MPI_SUCCESS )
394
            ierr =   HPL_packL( PANEL, ibufR, lbufR, I_RECV );
395
#endif
396
         if( ierr == MPI_SUCCESS )
397
            ierr =   MPI_Recv( _M_ROLL_BUFF_R, _M_ROLL_COUNT_R,
398
                               _M_ROLL_TYPE_R, partner, msgid, comm,
399
                               &PANEL->status[0] );
400
#ifdef HPL_USE_MPI_DATATYPE
401
         if( ierr == MPI_SUCCESS )
402
            ierr =   MPI_Type_free( &PANEL->dtypes[I_RECV] );
403
#endif
404
      }
405
      else
406
      {
407
         if( ierr == MPI_SUCCESS )
408
            ierr =   MPI_Recv( (void *)(&dummy), 0, MPI_BYTE, partner,
409
                               msgid, comm, &PANEL->status[0] );
410
      }
411
 
412
      if( ierr == MPI_SUCCESS )
413
         ierr =   MPI_Wait ( &PANEL->request[0], &PANEL->status[0] );
414
#ifdef HPL_USE_MPI_DATATYPE
415
      if( ( lbufS > 0 ) && ( ierr == MPI_SUCCESS ) )
416
         ierr =   MPI_Type_free( &PANEL->dtypes[I_SEND] );
417
#endif
418
   }
419
/*
420
 * If the message was received and being forwarded,  return HPL_SUCCESS.
421
 * If an error occured in an MPI call, return HPL_FAILURE.
422
 */
423
   *IFLAG = ( ierr == MPI_SUCCESS ? HPL_SUCCESS : HPL_FAILURE );
424

    
425
   return( *IFLAG );
426
}
427

    
428
#ifdef STDC_HEADERS
429
int HPL_bwait_blonM
430
(
431
   HPL_T_panel *              PANEL
432
)
433
#else
434
int HPL_bwait_blonM( PANEL )
435
   HPL_T_panel *              PANEL;
436
#endif
437
{
438
/* ..
439
 * .. Executable Statements ..
440
 */
441
   if( PANEL == NULL )           { return( HPL_SUCCESS ); }
442
   if( PANEL->grid->npcol <= 1 ) { return( HPL_SUCCESS ); }
443

    
444
   return( HPL_SUCCESS );
445
}