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

◆ main()

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

Definition at line 243 of file pzgemrdrv.c.

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