SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ main()

int main ( int  argc,
char *  argv[] 
)

Definition at line 240 of file pdgemrdrv.c.

241{
242 /* We initialize the data-block on the current processor, then redistribute
243 * it, and perform the inverse redistribution to compare the local memory
244 * with the initial one. */
245 /* Data file */
246 FILE *fp;
247 Int nbre, nbremax;
248 /* Data distribution 0 parameters */
249 Int p0, /* # of rows in the processor grid */
250 q0; /* # of columns in the processor grid */
251 /* Data distribution 1 parameters */
252 Int p1, q1;
253 /* # of parameter to be read on the keyboard */
254#define nbparameter 24
255 /* General variables */
256 Int blocksize0;
257 Int mypnum, nprocs;
258 Int parameters[nbparameter], nberrors;
259 Int i;
260 Int ia, ja, ib, jb, m, n;
261 Int gcontext, context0, context1;
262 Int myprow1, myprow0, mypcol0, mypcol1;
263 Int dummy;
264 MDESC ma, mb;
265 double *ptrmyblock, *ptrsavemyblock, *ptrmyblockcopy, *ptrmyblockvide;
266#ifdef UsingMpiBlacs
267 MPI_Init(&argc, &argv);
268#endif
269 setvbuf(stdout, NULL, _IOLBF, 0);
270 setvbuf(stderr, NULL, _IOLBF, 0);
271#ifdef T3D
272 free(malloc(14000000));
273#endif
274 initforpvm(argc, argv);
275 /* Read physical parameters */
276 Cblacs_pinfo(&mypnum, &nprocs);
277 /* initialize BLACS for the parameter communication */
278 Cblacs_get((Int)0, (Int)0, &gcontext);
279 Cblacs_gridinit(&gcontext, "R", nprocs, (Int)1);
280 Cblacs_gridinfo(gcontext, &dummy, &dummy, &mypnum, &dummy);
281 if (mypnum == 0) {
282 if ((fp = fopen("GEMR2D.dat", "r")) == NULL) {
283 fprintf(stderr, "Can't open GEMR2D.dat\n");
284 exit(1);
285 };
286 printf("\n// DGEMR2D TESTER for DOUBLE PRECISION //\n");
287 getparam(fp, &nbre, NULL);
288 printf("////////// %d tests \n\n", nbre);
289 parameters[0] = nbre;
290 Cigebs2d(gcontext, "All", "H", (Int)1, (Int)1, parameters, (Int)1);
291 } else {
292 Cigebr2d(gcontext, "All", "H", (Int)1, (Int)1, parameters, (Int)1, (Int)0, (Int)0);
293 nbre = parameters[0];
294 };
295 if (mypnum == 0) {
296 printf("\n m n m0 n0 sr0 sc0 i0 j0 p0 q0 nbr0 nbc0 \
297m1 n1 sr1 sc1 i1 j1 p1 q1 nbr1 nbc1\n\n");
298 };
299 /****** TEST LOOP *****/
300 /* Here we are in grip 1xnprocs */
301 nbremax = nbre;
302#ifdef DEBUG
303 fprintf(stderr, "bonjour,je suis le noeud %d\n", mypnum);
304#endif
305 while (nbre-- != 0) { /* Loop on the serie of tests */
306 /* All the processors read the parameters so we have to be in a 1xnprocs
307 * grid at each iteration */
308 /* Read processors grid and matrices parameters */
309 if (mypnum == 0) {
310 Int u, d;
311 getparam(fp,
312 &m, &n,
313 &ma.m, &ma.n, &ma.sprow, &ma.spcol,
314 &ia, &ja, &p0, &q0, &ma.nbrow, &ma.nbcol,
315 &mb.m, &mb.n, &mb.sprow, &mb.spcol,
316 &ib, &jb, &p1, &q1, &mb.nbrow, &mb.nbcol,
317 NULL);
318 printf("\t\t************* TEST # %d **********\n",
319 nbremax - nbre);
320 printf(" %3d %3d %3d %3d %3d %3d %3d %3d \
321%3d %3d %3d %3d %3d %3d %3d %3d %3d %3d %3d %3d %3d %3d",
322 m, n,
323 ma.m, ma.n, ma.sprow, ma.spcol,
324 ia, ja, p0, q0, ma.nbrow, ma.nbcol,
325 mb.m, mb.n, mb.sprow, mb.spcol,
326 ib, jb, p1, q1, mb.nbrow, mb.nbcol);
327 printf("\n");
328 if (p0 * q0 > nprocs || p1 * q1 > nprocs) {
329 fprintf(stderr, "not enough nodes:%d processors required\n",
330 max(p0 * q0, p1 * q1));
331 exit(1);
332 }
333 parameters[0] = p0;
334 parameters[1] = q0;
335 parameters[2] = ma.nbrow;
336 parameters[3] = ma.nbcol;
337 parameters[4] = p1;
338 parameters[5] = q1;
339 parameters[6] = mb.nbrow;
340 parameters[7] = mb.nbcol;
341 parameters[8] = ma.m;
342 parameters[9] = ma.n;
343 parameters[10] = ma.sprow;
344 parameters[11] = ma.spcol;
345 parameters[12] = mb.sprow;
346 parameters[13] = mb.spcol;
347 parameters[14] = ia;
348 parameters[15] = ja;
349 parameters[16] = ib;
350 parameters[17] = jb;
351 parameters[18] = m;
352 parameters[19] = n;
353 parameters[20] = mb.m;
354 parameters[21] = mb.n;
355 Cigebs2d(gcontext, "All", "H", (Int)1, nbparameter, parameters, (Int)1);
356 } else {
357 Cigebr2d(gcontext, "All", "H", (Int)1, nbparameter, parameters, (Int)1, (Int)0, (Int)0);
358 p0 = parameters[0];
359 q0 = parameters[1];
360 ma.nbrow = parameters[2];
361 ma.nbcol = parameters[3];
362 p1 = parameters[4];
363 q1 = parameters[5];
364 mb.nbrow = parameters[6];
365 mb.nbcol = parameters[7];
366 ma.m = parameters[8];
367 ma.n = parameters[9];
368 ma.sprow = parameters[10];
369 ma.spcol = parameters[11];
370 mb.sprow = parameters[12];
371 mb.spcol = parameters[13];
372 ia = parameters[14];
373 ja = parameters[15];
374 ib = parameters[16];
375 jb = parameters[17];
376 m = parameters[18];
377 n = parameters[19];
378 mb.m = parameters[20];
379 mb.n = parameters[21];
382 };
383 Cblacs_get((Int)0, (Int)0, &context0);
384 Cblacs_gridinit(&context0, "R", p0, q0);
385 Cblacs_get((Int)0, (Int)0, &context1);
386 Cblacs_gridinit(&context1, "R", p1, q1);
387 Cblacs_gridinfo(context0, &dummy, &dummy, &myprow0, &mypcol0);
388 if (myprow0 >= p0 || mypcol0 >= q0)
389 myprow0 = mypcol0 = -1;
390 Cblacs_gridinfo(context1, &dummy, &dummy, &myprow1, &mypcol1);
391 if (myprow1 >= p1 || mypcol1 >= q1)
392 myprow1 = mypcol1 = -1;
393 assert((myprow0 < p0 && mypcol0 < q0) || (myprow0 == -1 && mypcol0 == -1));
394 assert((myprow1 < p1 && mypcol1 < q1) || (myprow1 == -1 && mypcol1 == -1));
395 ma.ctxt = context0;
396 mb.ctxt = context1;
397 /* From here, we are not assuming that only the processors working in the
398 * redistribution are calling xxMR2D, but the ones not concerned will do
399 * nothing. */
400 /* We compute the exact size of the local memory block for the memory
401 * allocations */
402 if (myprow0 >= 0 && mypcol0 >= 0) {
403 blocksize0 = memoryblocksize(&ma);
404 ma.lda = localsize(SHIFT(myprow0, ma.sprow, p0), p0, ma.nbrow, ma.m);
405 setmemory(&ptrmyblock, blocksize0);
406 initblock(ptrmyblock, 1, blocksize0);
407 setmemory(&ptrmyblockcopy, blocksize0);
408 memcpy((char *) ptrmyblockcopy, (char *) ptrmyblock,
409 blocksize0 * sizeof(double));
410 setmemory(&ptrmyblockvide, blocksize0);
411 for (i = 0; i < blocksize0; i++)
412 ptrmyblockvide[i] = -1;
413 }; /* if (mypnum < p0 * q0) */
414 if (myprow1 >= 0 && mypcol1 >= 0) {
415 setmemory(&ptrsavemyblock, memoryblocksize(&mb));
416 mb.lda = localsize(SHIFT(myprow1, mb.sprow, p1), p1, mb.nbrow, mb.m);
417 }; /* if (mypnum < p1 * q1) */
418 /* Redistribute the matrix from grid 0 to grid 1 (memory location
419 * ptrmyblock to ptrsavemyblock) */
420 Cpdgemr2d(m, n,
421 ptrmyblock, ia, ja, &ma,
422 ptrsavemyblock, ib, jb, &mb, gcontext);
423 /* Perform the inverse redistribution of the matrix from grid 1 to grid 0
424 * (memory location ptrsavemyblock to ptrmyblockvide) */
425 Cpdgemr2d(m, n,
426 ptrsavemyblock, ib, jb, &mb,
427 ptrmyblockvide, ia, ja, &ma, gcontext);
428 /* Check the differences */
429 nberrors = 0;
430 if (myprow0 >= 0 && mypcol0 >= 0) {
431 /* only for the processors that do have data at the begining */
432 for (i = 0; i < blocksize0; i++) {
433 Int li, lj, gi, gj;
434 Int in;
435 in = 1;
436 li = i % ma.lda;
437 lj = i / ma.lda;
438 gi = (li / ma.nbrow) * p0 * ma.nbrow +
439 SHIFT(myprow0, ma.sprow, p0) * ma.nbrow + li % ma.nbrow;
440 gj = (lj / ma.nbcol) * q0 * ma.nbcol +
441 SHIFT(mypcol0, ma.spcol, q0) * ma.nbcol + lj % ma.nbcol;
442 assert(gi < ma.m && gj < ma.n);
443 gi -= (ia - 1);
444 gj -= (ja - 1);
445 if (gi < 0 || gj < 0 || gi >= m || gj >= n)
446 in = 0;
447 if (!in) {
448 ptrmyblockcopy[i] = -1;
449 }
450 if (ptrmyblockvide[i] != ptrmyblockcopy[i]) {
451 nberrors++;
452 printf("Proc %d : Error element number %d, value = %f , initvalue =%f \n"
453 ,mypnum, i,
454 ptrmyblockvide[i], ptrmyblockcopy[i]);
455 };
456 };
457 if (nberrors > 0) {
458 printf("Processor %d, has tested %d DOUBLE PRECISION elements,\
459Number of redistribution errors = %d \n",
460 mypnum, blocksize0, nberrors);
461 }
462 }
463 /* Look at the errors on all the processors at this point. */
464 Cigsum2d(gcontext, "All", "H", (Int)1, (Int)1, &nberrors, (Int)1, (Int)0, (Int)0);
465 if (mypnum == 0)
466 if (nberrors)
467 printf(" => Total number of redistribution errors = %d \n",
468 nberrors);
469 else
470 printf("TEST PASSED OK\n");
471 /* release memory for the next iteration */
472 if (myprow0 >= 0 && mypcol0 >= 0) {
473 freememory((char *) ptrmyblock);
474 freememory((char *) ptrmyblockvide);
475 freememory((char *) ptrmyblockcopy);
476 }; /* if (mypnum < p0 * q0) */
477 /* release memory for the next iteration */
478 if (myprow1 >= 0 && mypcol1 >= 0) {
479 freememory((char *) ptrsavemyblock);
480 };
481 if (myprow0 >= 0)
482 Cblacs_gridexit(context0);
483 if (myprow1 >= 0)
484 Cblacs_gridexit(context1);
485 }; /* while nbre != 0 */
486 if (mypnum == 0) {
487 fclose(fp);
488 };
489 Cblacs_exit((Int)0);
490 return 0;
491}/* main */
#define Int
Definition Bconfig.h:22
Int memoryblocksize()
#define freememory
Definition pdgemrdrv.c:138
#define SHIFT(row, sprow, nbrow)
Definition pdgemrdrv.c:94
void Cblacs_gridexit()
#define max(A, B)
Definition pdgemrdrv.c:95
static2 void initblock(double *block, Int m, Int n)
Definition pdgemrdrv.c:165
void Cigsum2d()
void Cblacs_pinfo()
Int localsize()
#define setmemory
Definition pdgemrdrv.c:137
void Cblacs_get()
void Cigebs2d()
#define BLOCK_CYCLIC_2D
Definition pdgemrdrv.c:89
void Cblacs_gridinit()
void Cblacs_gridinfo()
void initforpvm(Int argc, char *argv[])
Definition pdgemrdrv.c:223
void Cigebr2d()
void Cblacs_exit()
void Cpdgemr2d()
#define nbparameter
Int m
Definition pcgemr.c:166
Int spcol
Definition pcgemr.c:171
Int nbcol
Definition pcgemr.c:169
Int sprow
Definition pcgemr.c:170
Int nbrow
Definition pcgemr.c:168
Int ctxt
Definition pcgemr.c:165
Int desctype
Definition pcgemr.c:164
Int n
Definition pcgemr.c:167
Int lda
Definition pcgemr.c:172
Here is the call graph for this function: