ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pielget.f
Go to the documentation of this file.
1  SUBROUTINE pielget( SCOPE, TOP, ALPHA, A, IA, JA, DESCA )
2 *
3 * -- ScaLAPACK tools routine (version 1.7) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * May 1, 1997
7 *
8 * .. Scalar Arguments ..
9  CHARACTER*1 SCOPE, TOP
10  INTEGER ALPHA, IA, JA
11 * ..
12 * .. Array arguments ..
13  INTEGER A( * ), DESCA( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * PIELGET sets alpha to the distributed matrix entry A( IA, JA ).
20 * The value of alpha is set according to the scope.
21 *
22 * Notes
23 * =====
24 *
25 * Each global data object is described by an associated description
26 * vector. This vector stores the information required to establish
27 * the mapping between an object element and its corresponding process
28 * and memory location.
29 *
30 * Let A be a generic term for any 2D block cyclicly distributed array.
31 * Such a global array has an associated description vector DESCA.
32 * In the following comments, the character _ should be read as
33 * "of the global array".
34 *
35 * NOTATION STORED IN EXPLANATION
36 * --------------- -------------- --------------------------------------
37 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
38 * DTYPE_A = 1.
39 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
40 * the BLACS process grid A is distribu-
41 * ted over. The context itself is glo-
42 * bal, but the handle (the integer
43 * value) may vary.
44 * M_A (global) DESCA( M_ ) The number of rows in the global
45 * array A.
46 * N_A (global) DESCA( N_ ) The number of columns in the global
47 * array A.
48 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
49 * the rows of the array.
50 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
51 * the columns of the array.
52 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
53 * row of the array A is distributed.
54 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
55 * first column of the array A is
56 * distributed.
57 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
58 * array. LLD_A >= MAX(1,LOCr(M_A)).
59 *
60 * Let K be the number of rows or columns of a distributed matrix,
61 * and assume that its process grid has dimension p x q.
62 * LOCr( K ) denotes the number of elements of K that a process
63 * would receive if K were distributed over the p processes of its
64 * process column.
65 * Similarly, LOCc( K ) denotes the number of elements of K that a
66 * process would receive if K were distributed over the q processes of
67 * its process row.
68 * The values of LOCr() and LOCc() may be determined via a call to the
69 * ScaLAPACK tool function, NUMROC:
70 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
71 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
72 * An upper bound for these quantities may be computed by:
73 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
74 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
75 *
76 * Arguments
77 * =========
78 *
79 * SCOPE (global input) CHARACTER*1
80 * The BLACS scope in which alpha is updated.
81 * If SCOPE = 'R', alpha is updated only in the process row
82 * containing A( IA, JA ),
83 * If SCOPE = 'C', alpha is updated only in the process column
84 * containing A( IA, JA ),
85 * If SCOPE = 'A', alpha is updated in all the processes of the
86 * grid,
87 * otherwise alpha is updated only in the process containing
88 * A( IA, JA ).
89 *
90 * TOP (global input) CHARACTER*1
91 * The topology to be used if broadcast is needed.
92 *
93 * ALPHA (global output) @(typec), the scalar alpha.
94 *
95 * A (local input) @(typec) pointer into the local memory
96 * to an array of dimension (LLD_A,*) containing the local
97 * pieces of the distributed matrix A.
98 *
99 * IA (global input) INTEGER
100 * The row index in the global array A indicating the first
101 * row of sub( A ).
102 *
103 * JA (global input) INTEGER
104 * The column index in the global array A indicating the
105 * first column of sub( A ).
106 *
107 * DESCA (global and local input) INTEGER array of dimension DLEN_.
108 * The array descriptor for the distributed matrix A.
109 *
110 * =====================================================================
111 *
112 * .. Parameters ..
113  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
114  $ LLD_, MB_, M_, NB_, N_, RSRC_
115  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
116  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
117  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
118  INTEGER ZERO
119  parameter( zero = 0 )
120 * ..
121 * .. Local Scalars ..
122  INTEGER IACOL, IAROW, ICTXT, IIA, IOFFA, JJA, MYCOL,
123  $ MYROW, NPCOL, NPROW
124 * ..
125 * .. External Subroutines ..
126  EXTERNAL blacs_gridinfo, igebr2d, igebs2d, infog2l
127 * ..
128 * .. External Functions ..
129  LOGICAL LSAME
130  EXTERNAL lsame
131 * ..
132 * .. Executable Statements ..
133 *
134 * Get grid parameters.
135 *
136  ictxt = desca( ctxt_ )
137  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
138 *
139  CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, iia, jja,
140  $ iarow, iacol )
141 *
142  alpha = zero
143 *
144  IF( lsame( scope, 'R' ) ) THEN
145  IF( myrow.EQ.iarow ) THEN
146  IF( mycol.EQ.iacol ) THEN
147  ioffa = iia+(jja-1)*desca( lld_ )
148  CALL igebs2d( ictxt, scope, top, 1, 1, a( ioffa ), 1 )
149  alpha = a( ioffa )
150  ELSE
151  CALL igebr2d( ictxt, scope, top, 1, 1, alpha, 1,
152  $ iarow, iacol )
153  END IF
154  END IF
155  ELSE IF( lsame( scope, 'C' ) ) THEN
156  IF( mycol.EQ.iacol ) THEN
157  IF( myrow.EQ.iarow ) THEN
158  ioffa = iia+(jja-1)*desca( lld_ )
159  CALL igebs2d( ictxt, scope, top, 1, 1, a( ioffa ), 1 )
160  alpha = a( ioffa )
161  ELSE
162  CALL igebr2d( ictxt, scope, top, 1, 1, alpha, 1,
163  $ iarow, iacol )
164  END IF
165  END IF
166  ELSE IF( lsame( scope, 'A' ) ) THEN
167  IF( ( myrow.EQ.iarow ).AND.( mycol.EQ.iacol ) ) THEN
168  ioffa = iia+(jja-1)*desca( lld_ )
169  CALL igebs2d( ictxt, scope, top, 1, 1, a( ioffa ), 1 )
170  alpha = a( ioffa )
171  ELSE
172  CALL igebr2d( ictxt, scope, top, 1, 1, alpha, 1,
173  $ iarow, iacol )
174  END IF
175  ELSE
176  IF( myrow.EQ.iarow .AND. mycol.EQ.iacol )
177  $ alpha = a( iia+(jja-1)*desca( lld_ ) )
178  END IF
179 *
180  RETURN
181 *
182 * End of PIELGET
183 *
184  END
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.f:3
pielget
subroutine pielget(SCOPE, TOP, ALPHA, A, IA, JA, DESCA)
Definition: pielget.f:2