|
|
| |
| # lines: |
567 | | # code: |
567 | | # comment: | 0 | |
# blank: | 0 |
| # Variables: | 68 |
| # Callers: | 0 |
| # Callings: | 4 |
| # Words: | 373 |
| # Keywords: | 239 |
|
|
|
|
|
..
.. Array Arguments ..
..
Purpose
=======
PCTREVC computes some or all of the right and/or left eigenvectors of
a complex upper triangular matrix T in parallel.
The right eigenvector x and the left eigenvector y of T corresponding
to an eigenvalue w are defined by:
T*x = w*x, y'*T = w*y'
where y' denotes the conjugate transpose of the vector y.
If all eigenvectors are requested, the routine may either return the
matrices X and/or Y of right or left eigenvectors of T, or the
products Q*X and/or Q*Y, where Q is an input unitary
matrix. If T was obtained from the Schur factorization of an
original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
right or left eigenvectors of A.
Notes
=====
Each global data object is described by an associated description
vector. This vector stores the information required to establish
the mapping between an object element and its corresponding process
and memory location.
Let A be a generic term for any 2D block cyclicly distributed array.
Such a global array has an associated description vector DESCA.
In the following comments, the character _ should be read as
"of the global array".
NOTATION STORED IN EXPLANATION
--------------- -------------- --------------------------------------
DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
DTYPE_A = 1.
CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
the BLACS process grid A is distribu-
ted over. The context itself is glo-
bal, but the handle (the integer
value) may vary.
M_A (global) DESCA( M_ ) The number of rows in the global
array A.
N_A (global) DESCA( N_ ) The number of columns in the global
array A.
MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
the rows of the array.
NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
the columns of the array.
RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
row of the array A is distributed.
CSRC_A (global) DESCA( CSRC_ ) The process column over which the
first column of the array A is
distributed.
LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
array. LLD_A >= MAX(1,LOCr(M_A)).
Let K be the number of rows or columns of a distributed matrix,
and assume that its process grid has dimension r x c.
LOCr( K ) denotes the number of elements of K that a process
would receive if K were distributed over the r processes of its
process column.
Similarly, LOCc( K ) denotes the number of elements of K that a
process would receive if K were distributed over the c processes of
its process row.
The values of LOCr() and LOCc() may be determined via a call to the
ScaLAPACK tool function, NUMROC:
LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
An upper bound for these quantities may be computed by:
LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
Arguments
=========
SIDE (global input) CHARACTER*1
= 'R': compute right eigenvectors only;
= 'L': compute left eigenvectors only;
= 'B': compute both right and left eigenvectors.
HOWMNY (global input) CHARACTER*1
= 'A': compute all right and/or left eigenvectors;
= 'B': compute all right and/or left eigenvectors,
and backtransform them using the input matrices
supplied in VR and/or VL;
= 'S': compute selected right and/or left eigenvectors,
specified by the logical array SELECT.
SELECT (global input) LOGICAL array, dimension (N)
If HOWMNY = 'S', SELECT specifies the eigenvectors to be
computed.
If HOWMNY = 'A' or 'B', SELECT is not referenced.
To select the eigenvector corresponding to the j-th
eigenvalue, SELECT(j) must be set to .TRUE..
N (global input) INTEGER
The order of the matrix T. N >= 0.
T (global input/output) COMPLEX array, dimension
(DESCT(LLD_),*)
The upper triangular matrix T. T is modified, but restored
on exit.
DESCT (global and local input) INTEGER array of dimension DLEN_.
The array descriptor for the distributed matrix T.
VL (global input/output) COMPLEX array, dimension
(DESCVL(LLD_),MM)
On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
contain an N-by-N matrix Q (usually the unitary matrix Q of
Schur vectors returned by CHSEQR).
On exit, if SIDE = 'L' or 'B', VL contains:
if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
if HOWMNY = 'B', the matrix Q*Y;
if HOWMNY = 'S', the left eigenvectors of T specified by
SELECT, stored consecutively in the columns
of VL, in the same order as their
eigenvalues.
If SIDE = 'R', VL is not referenced.
DESCVL (global and local input) INTEGER array of dimension DLEN_.
The array descriptor for the distributed matrix VL.
VR (global input/output) COMPLEX array, dimension
(DESCVR(LLD_),MM)
On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
contain an N-by-N matrix Q (usually the unitary matrix Q of
Schur vectors returned by CHSEQR).
On exit, if SIDE = 'R' or 'B', VR contains:
if HOWMNY = 'A', the matrix X of right eigenvectors of T;
if HOWMNY = 'B', the matrix Q*X;
if HOWMNY = 'S', the right eigenvectors of T specified by
SELECT, stored consecutively in the columns
of VR, in the same order as their
eigenvalues.
If SIDE = 'L', VR is not referenced.
DESCVR (global and local input) INTEGER array of dimension DLEN_.
The array descriptor for the distributed matrix VR.
MM (global input) INTEGER
The number of columns in the arrays VL and/or VR. MM >= M.
M (global output) INTEGER
The number of columns in the arrays VL and/or VR actually
used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
is set to N. Each selected eigenvector occupies one
column.
WORK (local workspace) COMPLEX array,
dimension ( 2*DESCT(LLD_) )
Additional workspace may be required if PCLATTRS is updated
to use WORK.
RWORK (local workspace) REAL array,
dimension ( DESCT(LLD_) )
INFO (global output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
Further Details
===============
The algorithm used in this program is basically backward (forward)
substitution. It is the hope that scaling would be used to make the
the code robust against possible overflow. But scaling has not yet
been implemented in PCLATTRS which is called by this routine to solve
the triangular systems. PCLATTRS just calls PCTRSV.
Each eigenvector is normalized so that the element of largest
magnitude has magnitude 1; here the magnitude of a complex number
(x,y) is taken to be |x| + |y|.
Further Details
===============
Implemented by Mark R. Fahey, June, 2000
=====================================================================
.. Parameters ..
|
|
|
|
001 SUBROUTINE PCTREVC( SIDE , HOWMNY , SELECT , N , T , DESCT , VL , DESCVL ,
002 $VR , DESCVR , MM , M , WORK , RWORK , INFO )
003
004 * -- ScaLAPACK routine(version 1.7) --
005 * University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006 * and University of California , Berkeley.
007 * July 31 , 2001
008
009 * .. Scalar Arguments ..
010 CHARACTER HOWMNY , SIDE
011 INTEGER INFO , M , MM , N
012 REAL ZERO , ONE
013 PARAMETER( ZERO = 0.0E + 0 , ONE = 1.0E + 0 )
014 COMPLEX CZERO , CONE
015 PARAMETER( CZERO =( 0.0E + 0 , 0.0E + 0 ) ,
016 $CONE =( 1.0E + 0 , 0.0E + 0 ) )
017 INTEGER BLOCK_CYCLIC_2D , DLEN_ , DTYPE_ , CTXT_ , M_ , N_ ,
018 $MB_ , NB_ , RSRC_ , CSRC_ , LLD_
019 PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
020 $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
021 $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
022 * ..
023 * .. Local Scalars ..
024 LOGICAL ALLV , BOTHV , LEFTV , OVER , RIGHTV , SOMEV
025 INTEGER CONTXT , CSRC , I , ICOL , II , IROW , IS , ITMP1 ,
026 $ITMP2 , J , K , KI , LDT , LDVL , LDVR , LDW , MB ,
027 $MYCOL , MYROW , NB , NPCOL , NPROW , RSRC
028 REAL SELF
029 REAL OVFL , REMAXD , SCALE , SMIN , SMLNUM , ULP , UNFL
030 COMPLEX CDUM , REMAXC , SHIFT
031 * ..
032 * .. Local Arrays ..
033 INTEGER DESCW( DLEN_ )
034 * ..
035 * .. External Functions ..
036 LOGICAL LSAME
037 REAL PSLAMCH
038 EXTERNAL LSAME , PSLAMCH
039 * ..
040 * .. External Subroutines ..
041 EXTERNAL BLACS_GRIDINFO , DESCINIT , SGSUM2D , IGAMN2D ,
042 $INFOG2L , PSLABAD , PSCASUM , PXERBLA , PCAMAX ,
043 $PCCOPY , PCSSCAL , PCGEMV , PCLASET , PCLATTRS ,
044 $CGSUM2D
045 * ..
046 * .. Intrinsic Functions ..
047 INTRINSIC ABS , REAL , CMPLX , CONJG , AIMAG , MAX
048 * ..
049 * .. Statement Functions ..
050 REAL CABS1
051 * ..
052 * .. Statement Function definitions ..
053 CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )
054 * ..
055 * .. Executable Statements ..
056
057 * This is just to keep ftnchek happy
058 IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
058  
059 $ RSRC_.LT.0 )RETURN
060
061 CONTXT = DESCT( CTXT_ )
062 RSRC = DESCT( RSRC_ )
063 CSRC = DESCT( CSRC_ )
064 MB = DESCT( MB_ )
065 NB = DESCT( NB_ )
066 LDT = DESCT( LLD_ )
067 LDW = LDT
068 LDVR = DESCVR( LLD_ )
069 LDVL = DESCVL( LLD_ )
070
071 CALL BLACS_GRIDINFO( CONTXT , NPROW , NPCOL , MYROW , MYCOL )
072 SELF = MYROW*NPCOL + MYCOL
073
074 * Decode and test the input parameters
075
076 BOTHV = LSAME( SIDE , 'B' )
077 RIGHTV = LSAME( SIDE , 'R' ) .OR. BOTHV
078 LEFTV = LSAME( SIDE , 'L' ) .OR. BOTHV
079
080 ALLV = LSAME( HOWMNY , 'A' )
081 OVER = LSAME( HOWMNY , 'B' ) .OR. LSAME( HOWMNY , 'O' )
082 SOMEV = LSAME( HOWMNY , 'S' )
083
084 * Set M to the number of columns required to store the selected
085 * eigenvectors.
086
087 IF( SOMEV ) THEN
087
088 M = 0
089 DO 10 J = 1 , N
089
090 IF( SELECT( J ) )
090
091 $ M = M + 1
092 10 CONTINUE
092
093 ELSE
093
094 M = N
095 END IF
096
097 INFO = 0
098 IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
098
099 INFO = - 1
100 ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
100
101 INFO = - 2
102 ELSE IF( N.LT.0 ) THEN
102
103 INFO = - 4
104 ELSE IF( MM.LT.M ) THEN
104
105 INFO = - 11
106 END IF
107 CALL IGAMN2D( CONTXT , 'ALL' , ' ' , 1 , 1 , INFO , 1 , ITMP1 , ITMP2 , - 1 ,
108 $ - 1 , - 1 )
109 IF( INFO.LT.0 ) THEN
109
110 CALL PXERBLA( CONTXT , 'PCTREVC' , - INFO )
111 RETURN
112 END IF
113
114 * Quick return if possible.
115
116 IF( N.EQ.0 )
116
117 $ RETURN
118
119 * Set the constants to control overflow.
120
121 UNFL = PSLAMCH( CONTXT , 'Safe minimum' )
122 OVFL = ONE / UNFL
123 CALL PSLABAD ( CONTXT , UNFL , OVFL )
124 ULP = PSLAMCH( CONTXT , 'Precision' )
125 SMLNUM = UNFL*( N / ULP )
126
127 * Store the diagonal elements of T in working array WORK( LDW + 1 ).
128
129 DO 20 I = 1 , N
129
130 CALL INFOG2L( I , I , DESCT , NPROW , NPCOL , MYROW , MYCOL , IROW ,
131 $ ICOL , ITMP1 , ITMP2 )
132 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
132
133 WORK( LDW + IROW ) = T(( ICOL - 1 )*LDT + IROW )
134 END IF
135 20 CONTINUE
136
137 * Compute 1 - norm of each column of strictly upper triangular
138 * part of T to control overflow in triangular solver. Computed ,
139 * but not used. For use in PCLATTRS.
140
140
141 RWORK( 1 ) = ZERO
142 DO 30 J = 2 , N
142
143 CALL PSCASUM( J - 1 , RWORK( J ) , T , 1 , J , DESCT , 1 )
144 30 CONTINUE
145 * I replicate the norms in RWORK. Should they be distributed
146 * over the process rows?
146
147 CALL SGSUM2D( CONTXT , 'Row' , ' ' , N , 1 , RWORK , N , - 1 , - 1 )
148
149 IF( RIGHTV ) THEN
150
151 * Compute right eigenvectors.
152
153 * Need to set the distribution pattern of WORK
154
154
155 CALL DESCINIT( DESCW , N , 1 , NB , 1 , RSRC , CSRC , CONTXT , LDW ,
156 $ INFO )
157
158 IS = M
159 DO 70 KI = N , 1 , - 1
160
160
161 IF( SOMEV ) THEN
161
162 IF( .NOT.SELECT( KI ) )
162
163 $ GO TO 70
164 END IF
165
166 SMIN = ZERO
167 SHIFT = CZERO
168 CALL INFOG2L( KI , KI , DESCT , NPROW , NPCOL , MYROW , MYCOL ,
169 $ IROW , ICOL , ITMP1 , ITMP2 )
170 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
170
171 SHIFT = T(( ICOL - 1 )*LDT + IROW )
172 SMIN = MAX( ULP*( CABS1( SHIFT ) ) , SMLNUM )
173 END IF
174 CALL SGSUM2D( CONTXT , 'ALL' , ' ' , 1 , 1 , SMIN , 1 , - 1 , - 1 )
175 CALL CGSUM2D( CONTXT , 'ALL' , ' ' , 1 , 1 , SHIFT , 1 , - 1 , - 1 )
176
177 CALL INFOG2L( 1 , 1 , DESCW , NPROW , NPCOL , MYROW , MYCOL , IROW ,
178 $ ICOL , ITMP1 , ITMP2 )
179 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
179
180 WORK( 1 ) = CONE
181 END IF
182
183 * Form right - hand side. Distribute rhs onto first column
184 * of processor grid.
185
186 IF( KI.GT.1 ) THEN
186
187 CALL PCCOPY( KI - 1 , T , 1 , KI , DESCT , 1 , WORK , 1 , 1 , DESCW ,
188 $ 1 )
189 END IF
190 DO 40 K = 1 , KI - 1
190
191 CALL INFOG2L( K , 1 , DESCW , NPROW , NPCOL , MYROW , MYCOL ,
192 $ IROW , ICOL , ITMP1 , ITMP2 )
193 IF( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) THEN
193
194 WORK( IROW ) = - WORK( IROW )
195 END IF
196 40 CONTINUE
197
198 * Solve the triangular system :
199 * (T(1 : KI - 1 , 1 : KI - 1) - T(KI , KI))*X = SCALE*WORK.
200
200
201 DO 50 K = 1 , KI - 1
201
202 CALL INFOG2L( K , K , DESCT , NPROW , NPCOL , MYROW , MYCOL ,
203 $ IROW , ICOL , ITMP1 , ITMP2 )
204 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
204
205 T(( ICOL - 1 )*LDT + IROW ) = T(( ICOL - 1 )*LDT + IROW ) -
206 $ SHIFT
207 IF( CABS1( T(( ICOL - 1 )*LDT + IROW ) ).LT.SMIN ) THEN
207
208 T(( ICOL - 1 )*LDT + IROW ) = CMPLX( SMIN )
209 END IF
210 END IF
211 50 CONTINUE
212
212
213 IF( KI.GT.1 ) THEN
213
214 CALL PCLATTRS ( 'Upper' , 'No transpose' , 'Non - unit' , 'Y' ,
215 $ KI - 1 , T , 1 , 1 , DESCT , WORK , 1 , 1 , DESCW ,
216 $ SCALE , RWORK , INFO )
217 CALL INFOG2L( KI , 1 , DESCW , NPROW , NPCOL , MYROW , MYCOL ,
218 $ IROW , ICOL , ITMP1 , ITMP2 )
219 IF( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) THEN
219
220 WORK( IROW ) = CMPLX( SCALE )
221 END IF
222 END IF
223
224 * Copy the vector x or Q*x to VR and normalize.
225
226 IF( .NOT.OVER ) THEN
226
227 CALL PCCOPY( KI , WORK , 1 , 1 , DESCW , 1 , VR , 1 , IS , DESCVR ,
228 $ 1 )
229
230 CALL PCAMAX( KI , REMAXC , II , VR , 1 , IS , DESCVR , 1 )
231 REMAXD = ONE / MAX( CABS1( REMAXC ) , UNFL )
232 CALL PCSSCAL( KI , REMAXD , VR , 1 , IS , DESCVR , 1 )
233
234 CALL PCLASET ( ' ' , N - KI , 1 , CZERO , CZERO , VR , KI + 1 , IS ,
235 $ DESCVR )
236 ELSE
236
237 IF( KI.GT.1 )
237
238 $ CALL PCGEMV( 'N' , N , KI - 1 , CONE , VR , 1 , 1 , DESCVR ,
239 $ WORK , 1 , 1 , DESCW , 1 , CMPLX( SCALE ) ,
240 $ VR , 1 , KI , DESCVR , 1 )
241
242 CALL PCAMAX( N , REMAXC , II , VR , 1 , KI , DESCVR , 1 )
243 REMAXD = ONE / MAX( CABS1( REMAXC ) , UNFL )
244 CALL PCSSCAL( N , REMAXD , VR , 1 , KI , DESCVR , 1 )
245 END IF
246
247 * Set back the original diagonal elements of T.
248
249 DO 60 K = 1 , KI - 1
249
250 CALL INFOG2L( K , K , DESCT , NPROW , NPCOL , MYROW , MYCOL ,
251 $ IROW , ICOL , ITMP1 , ITMP2 )
252 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
252
253 T(( ICOL - 1 )*LDT + IROW ) = WORK( LDW + IROW )
254 END IF
255 60 CONTINUE
256
256
257 IS = IS - 1
258 70 CONTINUE
258
259 END IF
260
261 IF( LEFTV ) THEN
262
263 * Compute left eigenvectors.
264
265 * Need to set the distribution pattern of WORK
266
266
267 CALL DESCINIT( DESCW , N , 1 , MB , 1 , RSRC , CSRC , CONTXT , LDW ,
268 $ INFO )
269
270 IS = 1
271 DO 110 KI = 1 , N
272
272
273 IF( SOMEV ) THEN
273
274 IF( .NOT.SELECT( KI ) )
274
275 $ GO TO 110
276 END IF
277
278 SMIN = ZERO
279 SHIFT = CZERO
280 CALL INFOG2L( KI , KI , DESCT , NPROW , NPCOL , MYROW , MYCOL ,
281 $ IROW , ICOL , ITMP1 , ITMP2 )
282 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
282
283 SHIFT = T(( ICOL - 1 )*LDT + IROW )
284 SMIN = MAX( ULP*( CABS1( SHIFT ) ) , SMLNUM )
285 END IF
286 CALL SGSUM2D( CONTXT , 'ALL' , ' ' , 1 , 1 , SMIN , 1 , - 1 , - 1 )
287 CALL CGSUM2D( CONTXT , 'ALL' , ' ' , 1 , 1 , SHIFT , 1 , - 1 , - 1 )
288
289 CALL INFOG2L( N , 1 , DESCW , NPROW , NPCOL , MYROW , MYCOL , IROW ,
290 $ ICOL , ITMP1 , ITMP2 )
291 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
291
292 WORK( IROW ) = CONE
293 END IF
294
295 * Form right - hand side.
296
297 IF( KI.LT.N ) THEN
297
298 CALL PCCOPY( N - KI , T , KI , KI + 1 , DESCT , N , WORK , KI + 1 , 1 ,
299 $ DESCW , 1 )
300 END IF
301 DO 80 K = KI + 1 , N
301
302 CALL INFOG2L( K , 1 , DESCW , NPROW , NPCOL , MYROW , MYCOL ,
303 $ IROW , ICOL , ITMP1 , ITMP2 )
304 IF( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) THEN
304
305 WORK( IROW ) = - CONJG( WORK( IROW ) )
306 END IF
307 80 CONTINUE
308
309 * Solve the triangular system :
310 * (T(KI + 1 : N , KI + 1 : N) - T(KI , KI))'*X = SCALE*WORK.
311
311
312 DO 90 K = KI + 1 , N
312
313 CALL INFOG2L( K , K , DESCT , NPROW , NPCOL , MYROW , MYCOL ,
314 $ IROW , ICOL , ITMP1 , ITMP2 )
315 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
315
316 T(( ICOL - 1 )*LDT + IROW ) = T(( ICOL - 1 )*LDT + IROW ) -
317 $ SHIFT
318 IF( CABS1( T(( ICOL - 1 )*LDT + IROW ) ).LT.SMIN )
318
319 $ T(( ICOL - 1 )*LDT + IROW ) = CMPLX( SMIN )
320 END IF
321 90 CONTINUE
322
322
323 IF( KI.LT.N ) THEN
323
324 CALL PCLATTRS ( 'Upper' , 'Conjugate transpose' , 'Nonunit' ,
325 $ 'Y' , N - KI , T , KI + 1 , KI + 1 , DESCT , WORK ,
326 $ KI + 1 , 1 , DESCW , SCALE , RWORK , INFO )
327 CALL INFOG2L( KI , 1 , DESCW , NPROW , NPCOL , MYROW , MYCOL ,
328 $ IROW , ICOL , ITMP1 , ITMP2 )
329 IF( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) THEN
329
330 WORK( IROW ) = CMPLX( SCALE )
331 END IF
332 END IF
333
334 * Copy the vector x or Q*x to VL and normalize.
335
336 IF( .NOT.OVER ) THEN
336
337 CALL PCCOPY( N - KI + 1 , WORK , KI , 1 , DESCW , 1 , VL , KI , IS ,
338 $ DESCVL , 1 )
339
340 CALL PCAMAX( N - KI + 1 , REMAXC , II , VL , KI , IS , DESCVL , 1 )
341 REMAXD = ONE / MAX( CABS1( REMAXC ) , UNFL )
342 CALL PCSSCAL( N - KI + 1 , REMAXD , VL , KI , IS , DESCVL , 1 )
343
344 CALL PCLASET ( ' ' , KI - 1 , 1 , CZERO , CZERO , VL , 1 , IS ,
345 $ DESCVL )
346 ELSE
346
347 IF( KI.LT.N )
347
348 $ CALL PCGEMV( 'N' , N , N - KI , CONE , VL , 1 , KI + 1 , DESCVL ,
349 $ WORK , KI + 1 , 1 , DESCW , 1 , CMPLX( SCALE ) ,
350 $ VL , 1 , KI , DESCVL , 1 )
351
352 CALL PCAMAX( N , REMAXC , II , VL , 1 , KI , DESCVL , 1 )
353 REMAXD = ONE / MAX( CABS1( REMAXC ) , UNFL )
354 CALL PCSSCAL( N , REMAXD , VL , 1 , KI , DESCVL , 1 )
355 END IF
356
357 * Set back the original diagonal elements of T.
358
359 DO 100 K = KI + 1 , N
359
360 CALL INFOG2L( K , K , DESCT , NPROW , NPCOL , MYROW , MYCOL ,
361 $ IROW , ICOL , ITMP1 , ITMP2 )
362 IF(( MYROW.EQ.ITMP1 ) .AND.( MYCOL.EQ.ITMP2 ) ) THEN
362
363 T(( ICOL - 1 )*LDT + IROW ) = WORK( LDW + IROW )
364 END IF
365 100 CONTINUE
366
366
367 IS = IS + 1
368 110 CONTINUE
368
369 END IF
370
371 RETURN
372
373 * End of PCTREVC
374
375 END64
63
|
|
Variables in Routine PCTREVC()
| Summary Report |
| Data Type | Quantity | Size(byte) |
| CHARACTER | 2 | 2 |
| COMPLEX | 5 | 20 |
| INTEGER | 39 | 156 |
| LOGICAL | 7 | 7 |
| REAL | 15 | 60 |
| TOTAL | 68 | 245 |
List of Variables
CHARACTER
COMPLEX
| CDUM | CONE | CZERO | REMAXC | SHIFT |
INTEGER
| BLOCK_CYCLIC_2D | CONTXT | CSRC | CSRC_ | CTXT_ |
| DESCW( DLEN_ ) | DLEN_ | DTYPE_ | I | ICOL |
| II | INFO | IROW | IS | ITMP1 |
| ITMP2 | J | K | KI | LDT |
| LDVL | LDVR | LDW | LLD_ | M |
| M_ | MB | MB_ | MM | MYCOL |
| MYROW | N | N_ | NB | NB_ |
| NPCOL | NPROW | RSRC | RSRC_ | |
LOGICAL
| ALLV | BOTHV | LEFTV | LSAME | OVER |
| RIGHTV | SOMEV | | | |
REAL
| CABS1 | ONE | OVFL | PSLAMCH | REMAXD |
| RWORK | SCALE | SELF | SMIN | SMLNUM |
| T | ULP | UNFL | WORK | ZERO |
Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence | | - | | - | - | | ALLV | <--- | HOWMNYALLV = LSAME( HOWMNY, 'A' ), LSAMEALLV = LSAME( HOWMNY, 'A' ) |
| BOTHV | <--- | LSAMEBOTHV = LSAME( SIDE, 'B' ), SIDEBOTHV = LSAME( SIDE, 'B' ) |
| CABS1 | <--- | CDUMCABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) |
| CONTXT | <--- | CTXT_CONTXT = DESCT( CTXT_ ) |
| CSRC | <--- | CSRC_CSRC = DESCT( CSRC_ ) |
| I | <--- | NDO 20 I = 1, N |
| IS | <--- | ISIS = IS - 1{2IS = IS + 1}, MIS = M |
| J | <--- | NDO 30 J = 2, N{2DO 10 J = 1, N} |
| K | <--- | KIDO 40 K = 1, KI - 1{2DO 50 K = 1, KI - 1, 3DO 60 K = 1, KI - 1, 4DO 80 K = KI + 1, N, 5DO 90 K = KI + 1, N, 6DO 100 K = KI + 1, N}, NDO 80 K = KI + 1, N{2DO 90 K = KI + 1, N, 3DO 100 K = KI + 1, N} |
| KI | <--- | NDO 70 KI = N, 1, -1{2DO 110 KI = 1, N} |
| LDT | <--- | LLD_LDT = DESCT( LLD_ ) |
| LDVL | <--- | LLD_LDVL = DESCVL( LLD_ ) |
| LDVR | <--- | LLD_LDVR = DESCVR( LLD_ ) |
| LDW | <--- | LDTLDW = LDT |
| LEFTV | <--- | BOTHVLEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV, LSAMELEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV, SIDELEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV |
| M | <--- | NM = N |
| MB | <--- | MB_MB = DESCT( MB_ ) |
| NB | <--- | NB_NB = DESCT( NB_ ) |
| OVER | <--- | HOWMNYOVER = LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'O' ), LSAMEOVER = LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'O' ) |
| OVFL | <--- | ONEOVFL = ONE / UNFL, UNFLOVFL = ONE / UNFL |
| REMAXD | <--- | CABS1REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ){2REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 3REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 4REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL )}, ONEREMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ){2REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 3REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 4REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL )}, REMAXCREMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ){2REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 3REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 4REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL )}, UNFLREMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ){2REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 3REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL ), 4REMAXD = ONE / MAX( CABS1( REMAXC ), UNFL )} |
| RIGHTV | <--- | BOTHVRIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV, LSAMERIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV, SIDERIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV |
| RSRC | <--- | RSRC_RSRC = DESCT( RSRC_ ) |
| RWORK | <--- | ZERORWORK( 1 ) = ZERO |
| SELF | <--- | MYCOLSELF = MYROW*NPCOL + MYCOL, MYROWSELF = MYROW*NPCOL + MYCOL, NPCOLSELF = MYROW*NPCOL + MYCOL |
| SHIFT | <--- | CZEROSHIFT = CZERO{2SHIFT = CZERO}, ICOLSHIFT = T( ( ICOL-1 )*LDT+IROW ){2SHIFT = T( ( ICOL-1 )*LDT+IROW )}, IROWSHIFT = T( ( ICOL-1 )*LDT+IROW ){2SHIFT = T( ( ICOL-1 )*LDT+IROW )}, LDTSHIFT = T( ( ICOL-1 )*LDT+IROW ){2SHIFT = T( ( ICOL-1 )*LDT+IROW )}, TSHIFT = T( ( ICOL-1 )*LDT+IROW ){2SHIFT = T( ( ICOL-1 )*LDT+IROW )} |
| SMIN | <--- | CABS1SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ){2SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )}, SHIFTSMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ){2SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )}, SMLNUMSMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ){2SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )}, ULPSMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ){2SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )}, ZEROSMIN = ZERO{2SMIN = ZERO} |
| SMLNUM | <--- | NSMLNUM = UNFL*( N / ULP ), ULPSMLNUM = UNFL*( N / ULP ), UNFLSMLNUM = UNFL*( N / ULP ) |
| SOMEV | <--- | HOWMNYSOMEV = LSAME( HOWMNY, 'S' ), LSAMESOMEV = LSAME( HOWMNY, 'S' ) |
| T | <--- | ICOLT( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -{2T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -}, IROWT( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -{2T( ( ICOL-1 )*LDT+IROW ) = WORK( LDW+IROW ), 3T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -, 4T( ( ICOL-1 )*LDT+IROW ) = WORK( LDW+IROW )}, LDTT( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -{2T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -}, LDWT( ( ICOL-1 )*LDT+IROW ) = WORK( LDW+IROW ){2T( ( ICOL-1 )*LDT+IROW ) = WORK( LDW+IROW )}, SHIFTT( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -{2T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -}, SMINT( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN ), TT( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -{2T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -}, WORKT( ( ICOL-1 )*LDT+IROW ) = WORK( LDW+IROW ){2T( ( ICOL-1 )*LDT+IROW ) = WORK( LDW+IROW )} |
| ULP | <--- | PSLAMCHULP = PSLAMCH( CONTXT, 'Precision' ), CONTXTULP = PSLAMCH( CONTXT, 'Precision' ) |
| UNFL | <--- | PSLAMCHUNFL = PSLAMCH( CONTXT, 'Safe minimum' ), CONTXTUNFL = PSLAMCH( CONTXT, 'Safe minimum' ) |
| WORK | <--- | ICOLWORK( LDW+IROW ) = T( ( ICOL-1 )*LDT+IROW ), IROWWORK( LDW+IROW ) = T( ( ICOL-1 )*LDT+IROW ){2WORK( IROW ) = -WORK( IROW ), 3WORK( IROW ) = -CONJG( WORK( IROW ) )}, LDTWORK( LDW+IROW ) = T( ( ICOL-1 )*LDT+IROW ), SCALEWORK( IROW ) = CMPLX( SCALE ){2WORK( IROW ) = CMPLX( SCALE )}, CONEWORK( 1 ) = CONE{2WORK( IROW ) = CONE}, TWORK( LDW+IROW ) = T( ( ICOL-1 )*LDT+IROW ), WORKWORK( IROW ) = -WORK( IROW ){2WORK( IROW ) = -CONJG( WORK( IROW ) )} |
|
|
Analysis elements of the routine PCTREVC()
Put the mouse over each element to display detailed matching information
 Assigned variables |
| | | ALLV , BLOCK_CYCLIC_2D , BOTHV , CDUM , CONE , CONTXT , CSRC , CSRC_ , CTXT_ , CZERO , DLEN_ , DTYPE_ , I , INFO , IROW , IS , J , K , KI , LDT , LDVL , LDVR , LDW , LEFTV , LLD_ , M , M_ , MB , MB_ , N_ , NB , NB_ , ONE , OVER , OVFL , REMAXD , RIGHTV , RSRC , RSRC_ , RWORK , SELF , SHIFT , SMIN , SMLNUM , SOMEV , ULP , UNFL , WORK , ZERO |
|
| Active variables |
| | | ALLV , BLOCK_CYCLIC_2D , BOTHV , CABS1 , CDUM , CONE , CONTXT , CSRC , CSRC_ , CTXT_ , CZERO , DESCT , DESCVL , DESCVR , DESCW , DLEN_ , DTYPE_ , HOWMNY , I , ICOL , II , INFO , IROW , IS , ITMP1 , ITMP2 , J , K , KI , LDT , LDVL , LDVR , LDW , LEFTV , LLD_ , LSAME , M , M_ , MB , MB_ , MM , MYCOL , MYROW , N , N_ , NB , NB_ , NPCOL , NPROW , ONE , OVER , OVFL , PSLAMCH , REMAXC , REMAXD , RIGHTV , RSRC , RSRC_ , RWORK , SCALE , SELECT , SELF , SHIFT , SIDE , SMIN , SMLNUM , SOMEV , T , ULP , UNFL , VL , VR , WORK , ZERO |
|
| Accessed arrays [ array name : associated index ] |
| |  CABS1 | : CDUM , REMAXC , REMAXC , REMAXC , REMAXC , SHIFT , SHIFT , T( ( ICOL-1 )*LDT+IROW ) , T( ( ICOL-1 )*LDT+IROW ) |
| | DESCT | : CSRC_ , CTXT_ , LLD_ , MB_ , NB_ , RSRC_ |
| | DESCVL | : LLD_ |
| | DESCVR | : LLD_ |
| | DESCW | : DLEN_ |
| | LSAME | : HOWMNY, 'A' , HOWMNY, 'B' , HOWMNY, 'O' , HOWMNY, 'S' , SIDE, 'B' , SIDE, 'L' , SIDE, 'R' |
| | PSLAMCH | : CONTXT, 'Precision' , CONTXT, 'Safe minimum' |
| | RWORK | : 1 , J |
| | SELECT | : J , KI , KI |
| | T | : ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , ( ICOL-1 )*LDT+IROW , 1:KI-1,1:KI-1 , KI,KI , KI,KI , KI+1:N,KI+1:N |
| | WORK | : 1 , IROW , IROW , IROW , IROW , IROW , LDW+1 , LDW+IROW , LDW+IROW , LDW+IROW |
|
| Conditional statements [ statement : associated predicate ] |
| | do | : ( 10 J = 1 , N ) , ( 20 I = 1 , N ) , ( 30 J = 2 , N ) , ( 70 KI = N , 1 , - 1 ) , ( 40 K = 1 , KI - 1 ) , ( 50 K = 1 , KI - 1 ) , ( 60 K = 1 , KI - 1 ) , ( 110 KI = 1 , N ) , ( 80 K = KI + 1 , N ) , ( 90 K = KI + 1 , N ) , ( 100 K = KI + 1 , N ) |
| | for | : ( use in PCLATTRS. ) |
| | if | : ( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* ) , ( SOMEV ) , ( (SELECT( J ) ) ) , ( .NOT.RIGHTV .AND. .NOT.LEFTV ) , ( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) , ( N.LT.0 ) , ( MM.LT.M ) , ( INFO.LT.0 ) , ( possible. ) , ( N.EQ.0 ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( RIGHTV ) , ( SOMEV ) , ( (.NOT.SELECT( KI ) ) ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( KI.GT.1 ) , ( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( (CABS1( T( ( ICOL - 1 )*LDT + IROW ) ).LT.SMIN ) ) , ( KI.GT.1 ) , ( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) , ( .NOT.OVER ) , ( KI.GT.1 ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( LEFTV ) , ( SOMEV ) , ( (.NOT.SELECT( KI ) ) ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( KI.LT.N ) , ( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) , ( (CABS1( T( ( ICOL - 1 )*LDT + IROW ) ).LT.SMIN ) ) , ( KI.LT.N ) , ( MYROW.EQ.ITMP1 .AND. MYCOL.EQ.ITMP2 ) , ( .NOT.OVER ) , ( KI.LT.N ) , ( (( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) ) |
|
| List of variables |
ALLV
BLOCK_CYCLIC_2D
BOTHV
CABS1
CDUM
CONE
CONTXT
| CSRC
CSRC_
CTXT_
CZERO
DESCW( DLEN_ )
DLEN_
DTYPE_
HOWMNY
| I
ICOL
II
INFO
IROW
IS
ITMP1
ITMP2
| J
K
KI
LDT
LDVL
LDVR
LDW
LEFTV
| LLD_
LSAME
M
M_
MB
MB_
MM
MYCOL
| MYROW
N
N_
NB
NB_
NPCOL
NPROW
ONE
| OVER
OVFL
PSLAMCH
REMAXC
REMAXD
RIGHTV
RSRC
RSRC_
| RWORK
SCALE
SELF
SHIFT
SIDE
SMIN
SMLNUM
SOMEV
| T
ULP
UNFL
WORK
ZERO | | close
| |
ALLV
BLOCK_CYCLIC_2D
BOTHV
CABS1
CDUM
CONE
CONTXT
CSRC
CSRC_
CTXT_
CZERO
DESCW( DLEN_ )
DLEN_
DTYPE_
HOWMNY
I
ICOL
II
INFO
IROW
IS
ITMP1
ITMP2
J
K
KI
LDT
LDVL
LDVR
LDW
LEFTV
LLD_
LSAME
M
M_
MB
MB_
MM
MYCOL
MYROW
N
N_
NB
NB_
NPCOL
NPROW
ONE
OVER
OVFL
PSLAMCH
REMAXC
REMAXD
RIGHTV
RSRC
RSRC_
RWORK
SCALE
SELF
SHIFT
SIDE
SMIN
SMLNUM
SOMEV
T
ULP
UNFL
WORK
ZERO
369#352#113#105
| |
