SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
pdlaconsb.f
Go to the documentation of this file.
1 SUBROUTINE pdlaconsb( A, DESCA, I, L, M, H44, H33, H43H34, BUF,
2 $ LWORK )
3*
4* -- ScaLAPACK 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 INTEGER I, L, LWORK, M
11 DOUBLE PRECISION H33, H43H34, H44
12* ..
13* .. Array Arguments ..
14 INTEGER DESCA( * )
15 DOUBLE PRECISION A( * ), BUF( * )
16* ..
17*
18* Purpose
19* =======
20*
21* PDLACONSB looks for two consecutive small subdiagonal elements by
22* seeing the effect of starting a double shift QR iteration
23* given by H44, H33, & H43H34 and see if this would make a
24* subdiagonal negligible.
25*
26* Notes
27* =====
28*
29* Each global data object is described by an associated description
30* vector. This vector stores the information required to establish
31* the mapping between an object element and its corresponding process
32* and memory location.
33*
34* Let A be a generic term for any 2D block cyclicly distributed array.
35* Such a global array has an associated description vector DESCA.
36* In the following comments, the character _ should be read as
37* "of the global array".
38*
39* NOTATION STORED IN EXPLANATION
40* --------------- -------------- --------------------------------------
41* DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
42* DTYPE_A = 1.
43* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
44* the BLACS process grid A is distribu-
45* ted over. The context itself is glo-
46* bal, but the handle (the integer
47* value) may vary.
48* M_A (global) DESCA( M_ ) The number of rows in the global
49* array A.
50* N_A (global) DESCA( N_ ) The number of columns in the global
51* array A.
52* MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
53* the rows of the array.
54* NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
55* the columns of the array.
56* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
57* row of the array A is distributed.
58* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
59* first column of the array A is
60* distributed.
61* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
62* array. LLD_A >= MAX(1,LOCr(M_A)).
63*
64* Let K be the number of rows or columns of a distributed matrix,
65* and assume that its process grid has dimension p x q.
66* LOCr( K ) denotes the number of elements of K that a process
67* would receive if K were distributed over the p processes of its
68* process column.
69* Similarly, LOCc( K ) denotes the number of elements of K that a
70* process would receive if K were distributed over the q processes of
71* its process row.
72* The values of LOCr() and LOCc() may be determined via a call to the
73* ScaLAPACK tool function, NUMROC:
74* LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
75* LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
76* An upper bound for these quantities may be computed by:
77* LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
78* LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
79*
80* Arguments
81* =========
82*
83* A (global input) DOUBLE PRECISION array, dimension
84* (DESCA(LLD_),*)
85* On entry, the Hessenberg matrix whose tridiagonal part is
86* being scanned.
87* Unchanged on exit.
88*
89* DESCA (global and local input) INTEGER array of dimension DLEN_.
90* The array descriptor for the distributed matrix A.
91*
92* I (global input) INTEGER
93* The global location of the bottom of the unreduced
94* submatrix of A.
95* Unchanged on exit.
96*
97* L (global input) INTEGER
98* The global location of the top of the unreduced submatrix
99* of A.
100* Unchanged on exit.
101*
102* M (global output) INTEGER
103* On exit, this yields the starting location of the QR double
104* shift. This will satisfy: L <= M <= I-2.
105*
106* H44
107* H33
108* H43H34 (global input) DOUBLE PRECISION
109* These three values are for the double shift QR iteration.
110*
111* BUF (local output) DOUBLE PRECISION array of size LWORK.
112*
113* LWORK (global input) INTEGER
114* On exit, LWORK is the size of the work buffer.
115* This must be at least 7*Ceil( Ceil( (I-L)/HBL ) /
116* LCM(NPROW,NPCOL) )
117* Here LCM is least common multiple, and NPROWxNPCOL is the
118* logical grid size.
119*
120* Logic:
121* ======
122*
123* Two consecutive small subdiagonal elements will stall
124* convergence of a double shift if their product is small
125* relatively even if each is not very small. Thus it is
126* necessary to scan the "tridiagonal portion of the matrix." In
127* the LAPACK algorithm DLAHQR, a loop of M goes from I-2 down to
128* L and examines
129* H(m,m),H(m+1,m+1),H(m+1,m),H(m,m+1),H(m-1,m-1),H(m,m-1), and
130* H(m+2,m-1). Since these elements may be on separate
131* processors, the first major loop (10) goes over the tridiagonal
132* and has each node store whatever values of the 7 it has that
133* the node owning H(m,m) does not. This will occur on a border
134* and can happen in no more than 3 locations per block assuming
135* square blocks. There are 5 buffers that each node stores these
136* values: a buffer to send diagonally down and right, a buffer
137* to send up, a buffer to send left, a buffer to send diagonally
138* up and left and a buffer to send right. Each of these buffers
139* is actually stored in one buffer BUF where BUF(ISTR1+1) starts
140* the first buffer, BUF(ISTR2+1) starts the second, etc.. After
141* the values are stored, if there are any values that a node
142* needs, they will be sent and received. Then the next major
143* loop passes over the data and searches for two consecutive
144* small subdiagonals.
145*
146* Notes:
147*
148* This routine does a global maximum and must be called by all
149* processes.
150*
151*
152* Implemented by: G. Henry, November 17, 1996
153*
154* =====================================================================
155*
156* .. Parameters ..
157 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
158 $ lld_, mb_, m_, nb_, n_, rsrc_
159 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
160 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
161 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
162* ..
163* .. Local Scalars ..
164 INTEGER CONTXT, DOWN, HBL, IBUF1, IBUF2, IBUF3, IBUF4,
165 $ ibuf5, icol1, ii, ircv1, ircv2, ircv3, ircv4,
166 $ ircv5, irow1, isrc, istr1, istr2, istr3, istr4,
167 $ istr5, jj, jsrc, lda, left, modkm1, mycol,
168 $ myrow, npcol, nprow, num, right, up
169 DOUBLE PRECISION H00, H10, H11, H12, H21, H22, H33S, H44S, S,
170 $ tst1, ulp, v1, v2, v3
171* ..
172* .. External Functions ..
173 INTEGER ILCM
174 DOUBLE PRECISION PDLAMCH
175 EXTERNAL ilcm, pdlamch
176* ..
177* .. External Subroutines ..
178 EXTERNAL blacs_gridinfo, dgerv2d, dgesd2d, igamx2d,
179 $ infog2l, pxerbla
180* ..
181* .. Intrinsic Functions ..
182 INTRINSIC abs, mod
183* ..
184* .. Executable Statements ..
185*
186 hbl = desca( mb_ )
187 contxt = desca( ctxt_ )
188 lda = desca( lld_ )
189 ulp = pdlamch( contxt, 'PRECISION' )
190 CALL blacs_gridinfo( contxt, nprow, npcol, myrow, mycol )
191 left = mod( mycol+npcol-1, npcol )
192 right = mod( mycol+1, npcol )
193 up = mod( myrow+nprow-1, nprow )
194 down = mod( myrow+1, nprow )
195 num = nprow*npcol
196*
197* BUFFER1 starts at BUF(ISTR1+1) and will contain IBUF1 elements
198* BUFFER2 starts at BUF(ISTR2+1) and will contain IBUF2 elements
199* BUFFER3 starts at BUF(ISTR3+1) and will contain IBUF3 elements
200* BUFFER4 starts at BUF(ISTR4+1) and will contain IBUF4 elements
201* BUFFER5 starts at BUF(ISTR5+1) and will contain IBUF5 elements
202*
203 istr1 = 0
204 istr2 = ( ( i-l-1 ) / hbl )
205 IF( istr2*hbl.LT.( i-l-1 ) )
206 $ istr2 = istr2 + 1
207 ii = istr2 / ilcm( nprow, npcol )
208 IF( ii*ilcm( nprow, npcol ).LT.istr2 ) THEN
209 istr2 = ii + 1
210 ELSE
211 istr2 = ii
212 END IF
213 IF( lwork.LT.7*istr2 ) THEN
214 CALL pxerbla( contxt, 'PDLACONSB', 10 )
215 RETURN
216 END IF
217 istr3 = 3*istr2
218 istr4 = istr3 + istr2
219 istr5 = istr3 + istr3
220 CALL infog2l( i-2, i-2, desca, nprow, npcol, myrow, mycol, irow1,
221 $ icol1, ii, jj )
222 modkm1 = mod( i-3+hbl, hbl )
223*
224* Copy our relevant pieces of triadiagonal that we owe into
225* 5 buffers to send to whomever owns H(M,M) as M moves diagonally
226* up the tridiagonal
227*
228 ibuf1 = 0
229 ibuf2 = 0
230 ibuf3 = 0
231 ibuf4 = 0
232 ibuf5 = 0
233 ircv1 = 0
234 ircv2 = 0
235 ircv3 = 0
236 ircv4 = 0
237 ircv5 = 0
238 DO 10 m = i - 2, l, -1
239 IF( ( modkm1.EQ.0 ) .AND. ( down.EQ.ii ) .AND.
240 $ ( right.EQ.jj ) .AND. ( m.GT.l ) ) THEN
241*
242* We must pack H(M-1,M-1) and send it diagonal down
243*
244 IF( ( down.NE.myrow ) .OR. ( right.NE.mycol ) ) THEN
245 CALL infog2l( m-1, m-1, desca, nprow, npcol, myrow,
246 $ mycol, irow1, icol1, isrc, jsrc )
247 ibuf1 = ibuf1 + 1
248 buf( istr1+ibuf1 ) = a( ( icol1-1 )*lda+irow1 )
249 END IF
250 END IF
251 IF( ( modkm1.EQ.0 ) .AND. ( myrow.EQ.ii ) .AND.
252 $ ( right.EQ.jj ) .AND. ( m.GT.l ) ) THEN
253*
254* We must pack H(M ,M-1) and send it right
255*
256 IF( npcol.GT.1 ) THEN
257 CALL infog2l( m, m-1, desca, nprow, npcol, myrow, mycol,
258 $ irow1, icol1, isrc, jsrc )
259 ibuf5 = ibuf5 + 1
260 buf( istr5+ibuf5 ) = a( ( icol1-1 )*lda+irow1 )
261 END IF
262 END IF
263 IF( ( modkm1.EQ.hbl-1 ) .AND. ( up.EQ.ii ) .AND.
264 $ ( mycol.EQ.jj ) ) THEN
265*
266* We must pack H(M+1,M) and send it up
267*
268 IF( nprow.GT.1 ) THEN
269 CALL infog2l( m+1, m, desca, nprow, npcol, myrow, mycol,
270 $ irow1, icol1, isrc, jsrc )
271 ibuf2 = ibuf2 + 1
272 buf( istr2+ibuf2 ) = a( ( icol1-1 )*lda+irow1 )
273 END IF
274 END IF
275 IF( ( modkm1.EQ.hbl-1 ) .AND. ( myrow.EQ.ii ) .AND.
276 $ ( left.EQ.jj ) ) THEN
277*
278* We must pack H(M ,M+1) and send it left
279*
280 IF( npcol.GT.1 ) THEN
281 CALL infog2l( m, m+1, desca, nprow, npcol, myrow, mycol,
282 $ irow1, icol1, isrc, jsrc )
283 ibuf3 = ibuf3 + 1
284 buf( istr3+ibuf3 ) = a( ( icol1-1 )*lda+irow1 )
285 END IF
286 END IF
287 IF( ( modkm1.EQ.hbl-1 ) .AND. ( up.EQ.ii ) .AND.
288 $ ( left.EQ.jj ) ) THEN
289*
290* We must pack H(M+1,M+1) & H(M+2,M+1) and send it
291* diagonally up
292*
293 IF( ( up.NE.myrow ) .OR. ( left.NE.mycol ) ) THEN
294 CALL infog2l( m+1, m+1, desca, nprow, npcol, myrow,
295 $ mycol, irow1, icol1, isrc, jsrc )
296 ibuf4 = ibuf4 + 2
297 buf( istr4+ibuf4-1 ) = a( ( icol1-1 )*lda+irow1 )
298 buf( istr4+ibuf4 ) = a( ( icol1-1 )*lda+irow1+1 )
299 END IF
300 END IF
301 IF( ( modkm1.EQ.hbl-2 ) .AND. ( up.EQ.ii ) .AND.
302 $ ( mycol.EQ.jj ) ) THEN
303*
304* We must pack H(M+2,M+1) and send it up
305*
306 IF( nprow.GT.1 ) THEN
307 CALL infog2l( m+2, m+1, desca, nprow, npcol, myrow,
308 $ mycol, irow1, icol1, isrc, jsrc )
309 ibuf2 = ibuf2 + 1
310 buf( istr2+ibuf2 ) = a( ( icol1-1 )*lda+irow1 )
311 END IF
312 END IF
313*
314* Add up the receives
315*
316 IF( ( myrow.EQ.ii ) .AND. ( mycol.EQ.jj ) ) THEN
317 IF( ( modkm1.EQ.0 ) .AND. ( m.GT.l ) .AND.
318 $ ( ( nprow.GT.1 ) .OR. ( npcol.GT.1 ) ) ) THEN
319*
320* We must receive H(M-1,M-1) from diagonal up
321*
322 ircv1 = ircv1 + 1
323 END IF
324 IF( ( modkm1.EQ.0 ) .AND. ( npcol.GT.1 ) .AND. ( m.GT.l ) )
325 $ THEN
326*
327* We must receive H(M ,M-1) from left
328*
329 ircv5 = ircv5 + 1
330 END IF
331 IF( ( modkm1.EQ.hbl-1 ) .AND. ( nprow.GT.1 ) ) THEN
332*
333* We must receive H(M+1,M ) from down
334*
335 ircv2 = ircv2 + 1
336 END IF
337 IF( ( modkm1.EQ.hbl-1 ) .AND. ( npcol.GT.1 ) ) THEN
338*
339* We must receive H(M ,M+1) from right
340*
341 ircv3 = ircv3 + 1
342 END IF
343 IF( ( modkm1.EQ.hbl-1 ) .AND.
344 $ ( ( nprow.GT.1 ) .OR. ( npcol.GT.1 ) ) ) THEN
345*
346* We must receive H(M+1:M+2,M+1) from diagonal down
347*
348 ircv4 = ircv4 + 2
349 END IF
350 IF( ( modkm1.EQ.hbl-2 ) .AND. ( nprow.GT.1 ) ) THEN
351*
352* We must receive H(M+2,M+1) from down
353*
354 ircv2 = ircv2 + 1
355 END IF
356 END IF
357*
358* Possibly change owners (occurs only when MOD(M-1,HBL) = 0)
359*
360 IF( modkm1.EQ.0 ) THEN
361 ii = ii - 1
362 jj = jj - 1
363 IF( ii.LT.0 )
364 $ ii = nprow - 1
365 IF( jj.LT.0 )
366 $ jj = npcol - 1
367 END IF
368 modkm1 = modkm1 - 1
369 IF( modkm1.LT.0 )
370 $ modkm1 = hbl - 1
371 10 CONTINUE
372*
373*
374* Send data on to the appropriate node if there is any data to send
375*
376 IF( ibuf1.GT.0 ) THEN
377 CALL dgesd2d( contxt, ibuf1, 1, buf( istr1+1 ), ibuf1, down,
378 $ right )
379 END IF
380 IF( ibuf2.GT.0 ) THEN
381 CALL dgesd2d( contxt, ibuf2, 1, buf( istr2+1 ), ibuf2, up,
382 $ mycol )
383 END IF
384 IF( ibuf3.GT.0 ) THEN
385 CALL dgesd2d( contxt, ibuf3, 1, buf( istr3+1 ), ibuf3, myrow,
386 $ left )
387 END IF
388 IF( ibuf4.GT.0 ) THEN
389 CALL dgesd2d( contxt, ibuf4, 1, buf( istr4+1 ), ibuf4, up,
390 $ left )
391 END IF
392 IF( ibuf5.GT.0 ) THEN
393 CALL dgesd2d( contxt, ibuf5, 1, buf( istr5+1 ), ibuf5, myrow,
394 $ right )
395 END IF
396*
397* Receive appropriate data if there is any
398*
399 IF( ircv1.GT.0 ) THEN
400 CALL dgerv2d( contxt, ircv1, 1, buf( istr1+1 ), ircv1, up,
401 $ left )
402 END IF
403 IF( ircv2.GT.0 ) THEN
404 CALL dgerv2d( contxt, ircv2, 1, buf( istr2+1 ), ircv2, down,
405 $ mycol )
406 END IF
407 IF( ircv3.GT.0 ) THEN
408 CALL dgerv2d( contxt, ircv3, 1, buf( istr3+1 ), ircv3, myrow,
409 $ right )
410 END IF
411 IF( ircv4.GT.0 ) THEN
412 CALL dgerv2d( contxt, ircv4, 1, buf( istr4+1 ), ircv4, down,
413 $ right )
414 END IF
415 IF( ircv5.GT.0 ) THEN
416 CALL dgerv2d( contxt, ircv5, 1, buf( istr5+1 ), ircv5, myrow,
417 $ left )
418 END IF
419*
420* Start main loop
421*
422 ibuf1 = 0
423 ibuf2 = 0
424 ibuf3 = 0
425 ibuf4 = 0
426 ibuf5 = 0
427 CALL infog2l( i-2, i-2, desca, nprow, npcol, myrow, mycol, irow1,
428 $ icol1, ii, jj )
429 modkm1 = mod( i-3+hbl, hbl )
430 IF( ( myrow.EQ.ii ) .AND. ( mycol.EQ.jj ) .AND.
431 $ ( modkm1.NE.hbl-1 ) ) THEN
432 CALL infog2l( i-2, i-1, desca, nprow, npcol, myrow, mycol,
433 $ irow1, icol1, isrc, jsrc )
434 END IF
435*
436* Look for two consecutive small subdiagonal elements.
437*
438 DO 20 m = i - 2, l, -1
439*
440* Determine the effect of starting the double-shift QR
441* iteration at row M, and see if this would make H(M,M-1)
442* negligible.
443*
444 IF( ( myrow.EQ.ii ) .AND. ( mycol.EQ.jj ) ) THEN
445 IF( modkm1.EQ.0 ) THEN
446 h22 = a( ( icol1-1 )*lda+irow1+1 )
447 h11 = a( ( icol1-2 )*lda+irow1 )
448 v3 = a( ( icol1-1 )*lda+irow1+2 )
449 h21 = a( ( icol1-2 )*lda+irow1+1 )
450 h12 = a( ( icol1-1 )*lda+irow1 )
451 IF( m.GT.l ) THEN
452 IF( num.GT.1 ) THEN
453 ibuf1 = ibuf1 + 1
454 h00 = buf( istr1+ibuf1 )
455 ELSE
456 h00 = a( ( icol1-3 )*lda+irow1-1 )
457 END IF
458 IF( npcol.GT.1 ) THEN
459 ibuf5 = ibuf5 + 1
460 h10 = buf( istr5+ibuf5 )
461 ELSE
462 h10 = a( ( icol1-3 )*lda+irow1 )
463 END IF
464 END IF
465 END IF
466 IF( modkm1.EQ.hbl-1 ) THEN
467 CALL infog2l( m, m, desca, nprow, npcol, myrow, mycol,
468 $ irow1, icol1, isrc, jsrc )
469 h11 = a( ( icol1-1 )*lda+irow1 )
470 IF( num.GT.1 ) THEN
471 ibuf4 = ibuf4 + 2
472 h22 = buf( istr4+ibuf4-1 )
473 v3 = buf( istr4+ibuf4 )
474 ELSE
475 h22 = a( icol1*lda+irow1+1 )
476 v3 = a( ( icol1+1 )*lda+irow1+1 )
477 END IF
478 IF( nprow.GT.1 ) THEN
479 ibuf2 = ibuf2 + 1
480 h21 = buf( istr2+ibuf2 )
481 ELSE
482 h21 = a( ( icol1-1 )*lda+irow1+1 )
483 END IF
484 IF( npcol.GT.1 ) THEN
485 ibuf3 = ibuf3 + 1
486 h12 = buf( istr3+ibuf3 )
487 ELSE
488 h12 = a( icol1*lda+irow1 )
489 END IF
490 IF( m.GT.l ) THEN
491 h00 = a( ( icol1-2 )*lda+irow1-1 )
492 h10 = a( ( icol1-2 )*lda+irow1 )
493 END IF
494*
495* Adjust ICOL1 for next iteration where MODKM1=HBL-2
496*
497 icol1 = icol1 + 1
498 END IF
499 IF( modkm1.EQ.hbl-2 ) THEN
500 h22 = a( ( icol1-1 )*lda+irow1+1 )
501 h11 = a( ( icol1-2 )*lda+irow1 )
502 IF( nprow.GT.1 ) THEN
503 ibuf2 = ibuf2 + 1
504 v3 = buf( istr2+ibuf2 )
505 ELSE
506 v3 = a( ( icol1-1 )*lda+irow1+2 )
507 END IF
508 h21 = a( ( icol1-2 )*lda+irow1+1 )
509 h12 = a( ( icol1-1 )*lda+irow1 )
510 IF( m.GT.l ) THEN
511 h00 = a( ( icol1-3 )*lda+irow1-1 )
512 h10 = a( ( icol1-3 )*lda+irow1 )
513 END IF
514 END IF
515 IF( ( modkm1.LT.hbl-2 ) .AND. ( modkm1.GT.0 ) ) THEN
516 h22 = a( ( icol1-1 )*lda+irow1+1 )
517 h11 = a( ( icol1-2 )*lda+irow1 )
518 v3 = a( ( icol1-1 )*lda+irow1+2 )
519 h21 = a( ( icol1-2 )*lda+irow1+1 )
520 h12 = a( ( icol1-1 )*lda+irow1 )
521 IF( m.GT.l ) THEN
522 h00 = a( ( icol1-3 )*lda+irow1-1 )
523 h10 = a( ( icol1-3 )*lda+irow1 )
524 END IF
525 END IF
526 h44s = h44 - h11
527 h33s = h33 - h11
528 v1 = ( h33s*h44s-h43h34 ) / h21 + h12
529 v2 = h22 - h11 - h33s - h44s
530 s = abs( v1 ) + abs( v2 ) + abs( v3 )
531 v1 = v1 / s
532 v2 = v2 / s
533 v3 = v3 / s
534 IF( m.EQ.l )
535 $ GO TO 30
536 tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) )
537 IF( abs( h10 )*( abs( v2 )+abs( v3 ) ).LE.ulp*tst1 )
538 $ GO TO 30
539*
540* Slide indices diagonally up one for next iteration
541*
542 irow1 = irow1 - 1
543 icol1 = icol1 - 1
544 END IF
545 IF( m.EQ.l ) THEN
546*
547* Stop regardless of which node we are
548*
549 GO TO 30
550 END IF
551*
552* Possibly change owners if on border
553*
554 IF( modkm1.EQ.0 ) THEN
555 ii = ii - 1
556 jj = jj - 1
557 IF( ii.LT.0 )
558 $ ii = nprow - 1
559 IF( jj.LT.0 )
560 $ jj = npcol - 1
561 END IF
562 modkm1 = modkm1 - 1
563 IF( modkm1.LT.0 )
564 $ modkm1 = hbl - 1
565 20 CONTINUE
566 30 CONTINUE
567*
568 CALL igamx2d( contxt, 'ALL', ' ', 1, 1, m, 1, l, l, -1, -1, -1 )
569*
570 RETURN
571*
572* End of PDLACONSB
573*
574 END
infog2l
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)
Definition infog2l.f:3
pdlaconsb
subroutine pdlaconsb(a, desca, i, l, m, h44, h33, h43h34, buf, lwork)
Definition pdlaconsb.f:3
pxerbla
subroutine pxerbla(ictxt, srname, info)
Definition pxerbla.f:2