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

◆ pb_ainfog2l()

subroutine pb_ainfog2l ( integer  m,
integer  n,
integer  i,
integer  j,
integer, dimension( * )  desc,
integer  nprow,
integer  npcol,
integer  myrow,
integer  mycol,
integer  imb1,
integer  inb1,
integer  mp,
integer  nq,
integer  ii,
integer  jj,
integer  prow,
integer  pcol,
integer  rprow,
integer  rpcol 
)

Definition at line 2251 of file pblastim.f.

2254*
2255* -- PBLAS test routine (version 2.0) --
2256* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2257* and University of California, Berkeley.
2258* April 1, 1998
2259*
2260* .. Scalar Arguments ..
2261 INTEGER I, II, IMB1, INB1, J, JJ, M, MP, MYCOL, MYROW,
2262 $ N, NPCOL, NPROW, NQ, PCOL, PROW, RPCOL, RPROW
2263* ..
2264* .. Array Arguments ..
2265 INTEGER DESC( * )
2266* ..
2267*
2268* Purpose
2269* =======
2270*
2271* PB_AINFOG2L computes the starting local row and column indexes II,
2272* JJ corresponding to the submatrix starting globally at the entry
2273* pointed by I, J. This routine returns the coordinates in the grid of
2274* the process owning the matrix entry of global indexes I, J, namely
2275* PROW and PCOL. In addition, this routine computes the quantities MP
2276* and NQ, which are respectively the local number of rows and columns
2277* owned by the process of coordinate MYROW, MYCOL corresponding to the
2278* global submatrix A(I:I+M-1,J:J+N-1). Finally, the size of the first
2279* partial block and the relative process coordinates are also returned
2280* respectively in IMB, INB and RPROW, RPCOL.
2281*
2282* Notes
2283* =====
2284*
2285* A description vector is associated with each 2D block-cyclicly dis-
2286* tributed matrix. This vector stores the information required to
2287* establish the mapping between a matrix entry and its corresponding
2288* process and memory location.
2289*
2290* In the following comments, the character _ should be read as
2291* "of the distributed matrix". Let A be a generic term for any 2D
2292* block cyclicly distributed matrix. Its description vector is DESCA:
2293*
2294* NOTATION STORED IN EXPLANATION
2295* ---------------- --------------- ------------------------------------
2296* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
2297* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
2298* the NPROW x NPCOL BLACS process grid
2299* A is distributed over. The context
2300* itself is global, but the handle
2301* (the integer value) may vary.
2302* M_A (global) DESCA( M_ ) The number of rows in the distribu-
2303* ted matrix A, M_A >= 0.
2304* N_A (global) DESCA( N_ ) The number of columns in the distri-
2305* buted matrix A, N_A >= 0.
2306* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
2307* block of the matrix A, IMB_A > 0.
2308* INB_A (global) DESCA( INB_ ) The number of columns of the upper
2309* left block of the matrix A,
2310* INB_A > 0.
2311* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
2312* bute the last M_A-IMB_A rows of A,
2313* MB_A > 0.
2314* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
2315* bute the last N_A-INB_A columns of
2316* A, NB_A > 0.
2317* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
2318* row of the matrix A is distributed,
2319* NPROW > RSRC_A >= 0.
2320* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
2321* first column of A is distributed.
2322* NPCOL > CSRC_A >= 0.
2323* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
2324* array storing the local blocks of
2325* the distributed matrix A,
2326* IF( Lc( 1, N_A ) > 0 )
2327* LLD_A >= MAX( 1, Lr( 1, M_A ) )
2328* ELSE
2329* LLD_A >= 1.
2330*
2331* Let K be the number of rows of a matrix A starting at the global in-
2332* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
2333* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
2334* receive if these K rows were distributed over NPROW processes. If K
2335* is the number of columns of a matrix A starting at the global index
2336* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
2337* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
2338* these K columns were distributed over NPCOL processes.
2339*
2340* The values of Lr() and Lc() may be determined via a call to the func-
2341* tion PB_NUMROC:
2342* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
2343* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
2344*
2345* Arguments
2346* =========
2347*
2348* M (global input) INTEGER
2349* On entry, M specifies the global number of rows of the subma-
2350* trix. M must be at least zero.
2351*
2352* N (global input) INTEGER
2353* On entry, N specifies the global number of columns of the
2354* submatrix. N must be at least zero.
2355*
2356* I (global input) INTEGER
2357* On entry, I specifies the global starting row index of the
2358* submatrix. I must at least one.
2359*
2360* J (global input) INTEGER
2361* On entry, J specifies the global starting column index of
2362* the submatrix. J must at least one.
2363*
2364* DESC (global and local input) INTEGER array
2365* On entry, DESC is an integer array of dimension DLEN_. This
2366* is the array descriptor of the underlying matrix.
2367*
2368* NPROW (global input) INTEGER
2369* On entry, NPROW specifies the total number of process rows
2370* over which the matrix is distributed. NPROW must be at least
2371* one.
2372*
2373* NPCOL (global input) INTEGER
2374* On entry, NPCOL specifies the total number of process columns
2375* over which the matrix is distributed. NPCOL must be at least
2376* one.
2377*
2378* MYROW (local input) INTEGER
2379* On entry, MYROW specifies the row coordinate of the process
2380* whose local index II is determined. MYROW must be at least
2381* zero and strictly less than NPROW.
2382*
2383* MYCOL (local input) INTEGER
2384* On entry, MYCOL specifies the column coordinate of the pro-
2385* cess whose local index JJ is determined. MYCOL must be at
2386* least zero and strictly less than NPCOL.
2387*
2388* IMB1 (global output) INTEGER
2389* On exit, IMB1 specifies the number of rows of the upper left
2390* block of the submatrix. On exit, IMB1 is less or equal than
2391* M and greater or equal than MIN( 1, M ).
2392*
2393* INB1 (global output) INTEGER
2394* On exit, INB1 specifies the number of columns of the upper
2395* left block of the submatrix. On exit, INB1 is less or equal
2396* than N and greater or equal than MIN( 1, N ).
2397*
2398* MP (local output) INTEGER
2399* On exit, MP specifies the local number of rows of the subma-
2400* trix, that the processes of row coordinate MYROW own. MP is
2401* at least zero.
2402*
2403* NQ (local output) INTEGER
2404* On exit, NQ specifies the local number of columns of the
2405* submatrix, that the processes of column coordinate MYCOL
2406* own. NQ is at least zero.
2407*
2408* II (local output) INTEGER
2409* On exit, II specifies the local starting row index of the
2410* submatrix. On exit, II is at least one.
2411*
2412* JJ (local output) INTEGER
2413* On exit, JJ specifies the local starting column index of
2414* the submatrix. On exit, II is at least one.
2415*
2416* PROW (global output) INTEGER
2417* On exit, PROW specifies the row coordinate of the process
2418* that possesses the first row of the submatrix. On exit, PROW
2419* is -1 if DESC(RSRC_) is -1 on input, and, at least zero and
2420* strictly less than NPROW otherwise.
2421*
2422* PCOL (global output) INTEGER
2423* On exit, PCOL specifies the column coordinate of the process
2424* that possesses the first column of the submatrix. On exit,
2425* PCOL is -1 if DESC(CSRC_) is -1 on input, and, at least zero
2426* and strictly less than NPCOL otherwise.
2427*
2428* RPROW (global output) INTEGER
2429* On exit, RPROW specifies the relative row coordinate of the
2430* process that possesses the first row I of the submatrix. On
2431* exit, RPROW is -1 if DESC(RSRC_) is -1 on input, and, at
2432* least zero and strictly less than NPROW otherwise.
2433*
2434* RPCOL (global output) INTEGER
2435* On exit, RPCOL specifies the relative column coordinate of
2436* the process that possesses the first column J of the subma-
2437* trix. On exit, RPCOL is -1 if DESC(CSRC_) is -1 on input,
2438* and, at least zero and strictly less than NPCOL otherwise.
2439*
2440* -- Written on April 1, 1998 by
2441* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2442*
2443* =====================================================================
2444*
2445* .. Parameters ..
2446 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2447 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2448 $ RSRC_
2449 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2450 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2451 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2452 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2453* ..
2454* .. Local Scalars ..
2455 INTEGER CSRC, I1, ILOCBLK, J1, M1, MB, MYDIST, N1, NB,
2456 $ NBLOCKS, RSRC
2457* ..
2458* .. Local Arrays ..
2459 INTEGER DESC2( DLEN_ )
2460* ..
2461* .. External Subroutines ..
2462 EXTERNAL pb_desctrans
2463* ..
2464* .. Intrinsic Functions ..
2465 INTRINSIC min
2466* ..
2467* .. Executable Statements ..
2468*
2469* Convert descriptor
2470*
2471 CALL pb_desctrans( desc, desc2 )
2472*
2473 mb = desc2( mb_ )
2474 imb1 = desc2( imb_ )
2475 rsrc = desc2( rsrc_ )
2476*
2477 IF( ( rsrc.EQ.-1 ).OR.( nprow.EQ.1 ) ) THEN
2478*
2479 ii = i
2480 imb1 = imb1 - i + 1
2481 IF( imb1.LE.0 )
2482 $ imb1 = ( ( -imb1 ) / mb + 1 ) * mb + imb1
2483 imb1 = min( imb1, m )
2484 mp = m
2485 prow = rsrc
2486 rprow = 0
2487*
2488 ELSE
2489*
2490* Figure out PROW, II and IMB1 first
2491*
2492 IF( i.LE.imb1 ) THEN
2493*
2494 prow = rsrc
2495*
2496 IF( myrow.EQ.prow ) THEN
2497 ii = i
2498 ELSE
2499 ii = 1
2500 END IF
2501*
2502 imb1 = imb1 - i + 1
2503*
2504 ELSE
2505*
2506 i1 = i - imb1 - 1
2507 nblocks = i1 / mb + 1
2508 prow = rsrc + nblocks
2509 prow = prow - ( prow / nprow ) * nprow
2510*
2511 IF( myrow.EQ.rsrc ) THEN
2512*
2513 ilocblk = nblocks / nprow
2514*
2515 IF( ilocblk.GT.0 ) THEN
2516 IF( ( ilocblk*nprow ).GE.nblocks ) THEN
2517 IF( myrow.EQ.prow ) THEN
2518 ii = i + ( ilocblk - nblocks ) * mb
2519 ELSE
2520 ii = imb1 + ( ilocblk - 1 ) * mb + 1
2521 END IF
2522 ELSE
2523 ii = imb1 + ilocblk * mb + 1
2524 END IF
2525 ELSE
2526 ii = imb1 + 1
2527 END IF
2528*
2529 ELSE
2530*
2531 mydist = myrow - rsrc
2532 IF( mydist.LT.0 )
2533 $ mydist = mydist + nprow
2534*
2535 ilocblk = nblocks / nprow
2536*
2537 IF( ilocblk.GT.0 ) THEN
2538 mydist = mydist - nblocks + ilocblk * nprow
2539 IF( mydist.LT.0 ) THEN
2540 ii = ( ilocblk + 1 ) * mb + 1
2541 ELSE IF( myrow.EQ.prow ) THEN
2542 ii = i1 + ( ilocblk - nblocks + 1 ) * mb + 1
2543 ELSE
2544 ii = ilocblk * mb + 1
2545 END IF
2546 ELSE
2547 mydist = mydist - nblocks
2548 IF( mydist.LT.0 ) THEN
2549 ii = mb + 1
2550 ELSE IF( myrow.EQ.prow ) THEN
2551 ii = i1 + ( 1 - nblocks ) * mb + 1
2552 ELSE
2553 ii = 1
2554 END IF
2555 END IF
2556 END IF
2557*
2558 imb1 = nblocks * mb - i1
2559*
2560 END IF
2561*
2562* Figure out MP
2563*
2564 IF( m.LE.imb1 ) THEN
2565*
2566 IF( myrow.EQ.prow ) THEN
2567 mp = m
2568 ELSE
2569 mp = 0
2570 END IF
2571*
2572 ELSE
2573*
2574 m1 = m - imb1
2575 nblocks = m1 / mb + 1
2576*
2577 IF( myrow.EQ.prow ) THEN
2578 ilocblk = nblocks / nprow
2579 IF( ilocblk.GT.0 ) THEN
2580 IF( ( nblocks - ilocblk * nprow ).GT.0 ) THEN
2581 mp = imb1 + ilocblk * mb
2582 ELSE
2583 mp = m + mb * ( ilocblk - nblocks )
2584 END IF
2585 ELSE
2586 mp = imb1
2587 END IF
2588 ELSE
2589 mydist = myrow - prow
2590 IF( mydist.LT.0 )
2591 $ mydist = mydist + nprow
2592 ilocblk = nblocks / nprow
2593 IF( ilocblk.GT.0 ) THEN
2594 mydist = mydist - nblocks + ilocblk * nprow
2595 IF( mydist.LT.0 ) THEN
2596 mp = ( ilocblk + 1 ) * mb
2597 ELSE IF( mydist.GT.0 ) THEN
2598 mp = ilocblk * mb
2599 ELSE
2600 mp = m1 + mb * ( ilocblk - nblocks + 1 )
2601 END IF
2602 ELSE
2603 mydist = mydist - nblocks
2604 IF( mydist.LT.0 ) THEN
2605 mp = mb
2606 ELSE IF( mydist.GT.0 ) THEN
2607 mp = 0
2608 ELSE
2609 mp = m1 + mb * ( 1 - nblocks )
2610 END IF
2611 END IF
2612 END IF
2613*
2614 END IF
2615*
2616 imb1 = min( imb1, m )
2617 rprow = myrow - prow
2618 IF( rprow.LT.0 )
2619 $ rprow = rprow + nprow
2620*
2621 END IF
2622*
2623 nb = desc2( nb_ )
2624 inb1 = desc2( inb_ )
2625 csrc = desc2( csrc_ )
2626*
2627 IF( ( csrc.EQ.-1 ).OR.( npcol.EQ.1 ) ) THEN
2628*
2629 jj = j
2630 inb1 = inb1 - i + 1
2631 IF( inb1.LE.0 )
2632 $ inb1 = ( ( -inb1 ) / nb + 1 ) * nb + inb1
2633 inb1 = min( inb1, n )
2634 nq = n
2635 pcol = csrc
2636 rpcol = 0
2637*
2638 ELSE
2639*
2640* Figure out PCOL, JJ and INB1 first
2641*
2642 IF( j.LE.inb1 ) THEN
2643*
2644 pcol = csrc
2645*
2646 IF( mycol.EQ.pcol ) THEN
2647 jj = j
2648 ELSE
2649 jj = 1
2650 END IF
2651*
2652 inb1 = inb1 - j + 1
2653*
2654 ELSE
2655*
2656 j1 = j - inb1 - 1
2657 nblocks = j1 / nb + 1
2658 pcol = csrc + nblocks
2659 pcol = pcol - ( pcol / npcol ) * npcol
2660*
2661 IF( mycol.EQ.csrc ) THEN
2662*
2663 ilocblk = nblocks / npcol
2664*
2665 IF( ilocblk.GT.0 ) THEN
2666 IF( ( ilocblk*npcol ).GE.nblocks ) THEN
2667 IF( mycol.EQ.pcol ) THEN
2668 jj = j + ( ilocblk - nblocks ) * nb
2669 ELSE
2670 jj = inb1 + ( ilocblk - 1 ) * nb + 1
2671 END IF
2672 ELSE
2673 jj = inb1 + ilocblk * nb + 1
2674 END IF
2675 ELSE
2676 jj = inb1 + 1
2677 END IF
2678*
2679 ELSE
2680*
2681 mydist = mycol - csrc
2682 IF( mydist.LT.0 )
2683 $ mydist = mydist + npcol
2684*
2685 ilocblk = nblocks / npcol
2686*
2687 IF( ilocblk.GT.0 ) THEN
2688 mydist = mydist - nblocks + ilocblk * npcol
2689 IF( mydist.LT.0 ) THEN
2690 jj = ( ilocblk + 1 ) * nb + 1
2691 ELSE IF( mycol.EQ.pcol ) THEN
2692 jj = j1 + ( ilocblk - nblocks + 1 ) * nb + 1
2693 ELSE
2694 jj = ilocblk * nb + 1
2695 END IF
2696 ELSE
2697 mydist = mydist - nblocks
2698 IF( mydist.LT.0 ) THEN
2699 jj = nb + 1
2700 ELSE IF( mycol.EQ.pcol ) THEN
2701 jj = j1 + ( 1 - nblocks ) * nb + 1
2702 ELSE
2703 jj = 1
2704 END IF
2705 END IF
2706 END IF
2707*
2708 inb1 = nblocks * nb - j1
2709*
2710 END IF
2711*
2712* Figure out NQ
2713*
2714 IF( n.LE.inb1 ) THEN
2715*
2716 IF( mycol.EQ.pcol ) THEN
2717 nq = n
2718 ELSE
2719 nq = 0
2720 END IF
2721*
2722 ELSE
2723*
2724 n1 = n - inb1
2725 nblocks = n1 / nb + 1
2726*
2727 IF( mycol.EQ.pcol ) THEN
2728 ilocblk = nblocks / npcol
2729 IF( ilocblk.GT.0 ) THEN
2730 IF( ( nblocks - ilocblk * npcol ).GT.0 ) THEN
2731 nq = inb1 + ilocblk * nb
2732 ELSE
2733 nq = n + nb * ( ilocblk - nblocks )
2734 END IF
2735 ELSE
2736 nq = inb1
2737 END IF
2738 ELSE
2739 mydist = mycol - pcol
2740 IF( mydist.LT.0 )
2741 $ mydist = mydist + npcol
2742 ilocblk = nblocks / npcol
2743 IF( ilocblk.GT.0 ) THEN
2744 mydist = mydist - nblocks + ilocblk * npcol
2745 IF( mydist.LT.0 ) THEN
2746 nq = ( ilocblk + 1 ) * nb
2747 ELSE IF( mydist.GT.0 ) THEN
2748 nq = ilocblk * nb
2749 ELSE
2750 nq = n1 + nb * ( ilocblk - nblocks + 1 )
2751 END IF
2752 ELSE
2753 mydist = mydist - nblocks
2754 IF( mydist.LT.0 ) THEN
2755 nq = nb
2756 ELSE IF( mydist.GT.0 ) THEN
2757 nq = 0
2758 ELSE
2759 nq = n1 + nb * ( 1 - nblocks )
2760 END IF
2761 END IF
2762 END IF
2763*
2764 END IF
2765*
2766 inb1 = min( inb1, n )
2767 rpcol = mycol - pcol
2768 IF( rpcol.LT.0 )
2769 $ rpcol = rpcol + npcol
2770*
2771 END IF
2772*
2773 RETURN
2774*
2775* End of PB_AINFOG2L
2776*
pb_desctrans
subroutine pb_desctrans(descin, descout)
Definition pblastst.f:2964
min
#define min(A, B)
Definition pcgemr.c:181
Here is the call graph for this function: