ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzlaqge.f
Go to the documentation of this file.
1  SUBROUTINE pzlaqge( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND,
2  $ AMAX, EQUED )
3 *
4 * -- ScaLAPACK auxiliary routine (version 1.7) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * May 1, 1997
8 *
9 * .. Scalar Arguments ..
10  CHARACTER EQUED
11  INTEGER IA, JA, M, N
12  DOUBLE PRECISION AMAX, COLCND, ROWCND
13 * ..
14 * .. Array Arguments ..
15  INTEGER DESCA( * )
16  DOUBLE PRECISION C( * ), R( * )
17  COMPLEX*16 A( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * PZLAQGE equilibrates a general M-by-N distributed matrix
24 * sub( A ) = A(IA:IA+M-1,JA:JA+N-1) using the row and scaling
25 * factors in the vectors R and C.
26 *
27 * Notes
28 * =====
29 *
30 * Each global data object is described by an associated description
31 * vector. This vector stores the information required to establish
32 * the mapping between an object element and its corresponding process
33 * and memory location.
34 *
35 * Let A be a generic term for any 2D block cyclicly distributed array.
36 * Such a global array has an associated description vector DESCA.
37 * In the following comments, the character _ should be read as
38 * "of the global array".
39 *
40 * NOTATION STORED IN EXPLANATION
41 * --------------- -------------- --------------------------------------
42 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
43 * DTYPE_A = 1.
44 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
45 * the BLACS process grid A is distribu-
46 * ted over. The context itself is glo-
47 * bal, but the handle (the integer
48 * value) may vary.
49 * M_A (global) DESCA( M_ ) The number of rows in the global
50 * array A.
51 * N_A (global) DESCA( N_ ) The number of columns in the global
52 * array A.
53 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
54 * the rows of the array.
55 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
56 * the columns of the array.
57 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
58 * row of the array A is distributed.
59 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
60 * first column of the array A is
61 * distributed.
62 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
63 * array. LLD_A >= MAX(1,LOCr(M_A)).
64 *
65 * Let K be the number of rows or columns of a distributed matrix,
66 * and assume that its process grid has dimension p x q.
67 * LOCr( K ) denotes the number of elements of K that a process
68 * would receive if K were distributed over the p processes of its
69 * process column.
70 * Similarly, LOCc( K ) denotes the number of elements of K that a
71 * process would receive if K were distributed over the q processes of
72 * its process row.
73 * The values of LOCr() and LOCc() may be determined via a call to the
74 * ScaLAPACK tool function, NUMROC:
75 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
76 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
77 * An upper bound for these quantities may be computed by:
78 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
79 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
80 *
81 * Arguments
82 * =========
83 *
84 * M (global input) INTEGER
85 * The number of rows to be operated on i.e the number of rows
86 * of the distributed submatrix sub( A ). M >= 0.
87 *
88 * N (global input) INTEGER
89 * The number of columns to be operated on i.e the number of
90 * columns of the distributed submatrix sub( A ). N >= 0.
91 *
92 * A (local input/local output) COMPLEX*16 pointer into the
93 * local memory to an array of dimension (LLD_A,LOCc(JA+N-1))
94 * containing on entry the M-by-N matrix sub( A ). On exit,
95 * the equilibrated distributed matrix. See EQUED for the
96 * form of the equilibrated distributed submatrix.
97 *
98 * IA (global input) INTEGER
99 * The row index in the global array A indicating the first
100 * row of sub( A ).
101 *
102 * JA (global input) INTEGER
103 * The column index in the global array A indicating the
104 * first column of sub( A ).
105 *
106 * DESCA (global and local input) INTEGER array of dimension DLEN_.
107 * The array descriptor for the distributed matrix A.
108 *
109 * R (local input) DOUBLE PRECISION array, dimension LOCr(M_A)
110 * The row scale factors for sub( A ). R is aligned with the
111 * distributed matrix A, and replicated across every process
112 * column. R is tied to the distributed matrix A.
113 *
114 * C (local input) DOUBLE PRECISION array, dimension LOCc(N_A)
115 * The column scale factors of sub( A ). C is aligned with the
116 * distributed matrix A, and replicated down every process
117 * row. C is tied to the distributed matrix A.
118 *
119 * ROWCND (global input) DOUBLE PRECISION
120 * The global ratio of the smallest R(i) to the largest R(i),
121 * IA <= i <= IA+M-1.
122 *
123 * COLCND (global input) DOUBLE PRECISION
124 * The global ratio of the smallest C(i) to the largest C(i),
125 * JA <= j <= JA+N-1.
126 *
127 * AMAX (global input) DOUBLE PRECISION
128 * Absolute value of largest distributed submatrix entry.
129 *
130 * EQUED (global output) CHARACTER
131 * Specifies the form of equilibration that was done.
132 * = 'N': No equilibration
133 * = 'R': Row equilibration, i.e., sub( A ) has been pre-
134 * multiplied by diag(R(IA:IA+M-1)),
135 * = 'C': Column equilibration, i.e., sub( A ) has been post-
136 * multiplied by diag(C(JA:JA+N-1)),
137 * = 'B': Both row and column equilibration, i.e., sub( A )
138 * has been replaced by
139 * diag(R(IA:IA+M-1)) * sub( A ) * diag(C(JA:JA+N-1)).
140 *
141 * Internal Parameters
142 * ===================
143 *
144 * THRESH is a threshold value used to decide if row or column scaling
145 * should be done based on the ratio of the row or column scaling
146 * factors. If ROWCND < THRESH, row scaling is done, and if
147 * COLCND < THRESH, column scaling is done.
148 *
149 * LARGE and SMALL are threshold values used to decide if row scaling
150 * should be done based on the absolute size of the largest matrix
151 * element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
152 *
153 * =====================================================================
154 *
155 * .. Parameters ..
156  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
157  $ lld_, mb_, m_, nb_, n_, rsrc_
158  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
159  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
160  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
161  DOUBLE PRECISION ONE, THRESH
162  parameter( one = 1.0d+0, thresh = 0.1d+0 )
163 * ..
164 * .. Local Scalars ..
165  INTEGER I, IACOL, IAROW, ICOFF, ICTXT, IIA, IOFFA,
166  $ iroff, j, jja, lda, mp, mycol, myrow, npcol,
167  $ nprow, nq
168  DOUBLE PRECISION CJ, LARGE, SMALL
169 * ..
170 * .. External Subroutines ..
171  EXTERNAL blacs_gridinfo, infog2l
172 * ..
173 * .. External Functions ..
174  INTEGER NUMROC
175  DOUBLE PRECISION PDLAMCH
176  EXTERNAL numroc, pdlamch
177 * ..
178 * .. Intrinsic Functions ..
179  INTRINSIC mod
180 * ..
181 * .. Executable Statements ..
182 *
183 * Quick return if possible
184 *
185  IF( m.LE.0 .OR. n.LE.0 ) THEN
186  equed = 'N'
187  RETURN
188  END IF
189 *
190 * Get grid parameters and compute local indexes
191 *
192  ictxt = desca( ctxt_ )
193  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
194  CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, iia, jja,
195  $ iarow, iacol )
196  iroff = mod( ia-1, desca( mb_ ) )
197  icoff = mod( ja-1, desca( nb_ ) )
198  mp = numroc( m+iroff, desca( mb_ ), myrow, iarow, nprow )
199  nq = numroc( n+icoff, desca( nb_ ), mycol, iacol, npcol )
200  IF( myrow.EQ.iarow )
201  $ mp = mp - iroff
202  IF( mycol.EQ.iacol )
203  $ nq = nq - icoff
204  lda = desca( lld_ )
205 *
206 * Initialize LARGE and SMALL.
207 *
208  small = pdlamch( ictxt, 'Safe minimum' ) /
209  $ pdlamch( ictxt, 'Precision' )
210  large = one / small
211 *
212  IF( rowcnd.GE.thresh .AND. amax.GE.small .AND. amax.LE.large )
213  $ THEN
214 *
215 * No row scaling
216 *
217  IF( colcnd.GE.thresh ) THEN
218 *
219 * No column scaling
220 *
221  equed = 'N'
222 *
223  ELSE
224 *
225 * Column scaling
226 *
227  ioffa = (jja-1)*lda
228  DO 20 j = jja, jja+nq-1
229  cj = c( j )
230  DO 10 i = iia, iia+mp-1
231  a( ioffa + i ) = cj*a( ioffa + i )
232  10 CONTINUE
233  ioffa = ioffa + lda
234  20 CONTINUE
235  equed = 'C'
236  END IF
237 *
238  ELSE IF( colcnd.GE.thresh ) THEN
239 *
240 * Row scaling, no column scaling
241 *
242  ioffa = (jja-1)*lda
243  DO 40 j = jja, jja+nq-1
244  DO 30 i = iia, iia+mp-1
245  a( ioffa + i ) = r( i )*a( ioffa + i )
246  30 CONTINUE
247  ioffa = ioffa + lda
248  40 CONTINUE
249  equed = 'R'
250 *
251  ELSE
252 *
253 * Row and column scaling
254 *
255  ioffa = (jja-1)*lda
256  DO 60 j = jja, jja+nq-1
257  cj = c( j )
258  DO 50 i = iia, iia+mp-1
259  a( ioffa + i ) = cj*r( i )*a( ioffa + i )
260  50 CONTINUE
261  ioffa = ioffa + lda
262  60 CONTINUE
263  equed = 'B'
264 *
265  END IF
266 *
267  RETURN
268 *
269 * End of PZLAQGE
270 *
271  END
pzlaqge
subroutine pzlaqge(M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, AMAX, EQUED)
Definition: pzlaqge.f:3
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.f:3