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

◆ pzlaconsb()

subroutine pzlaconsb ( complex*16, dimension( * )  a,
integer, dimension( * )  desca,
integer  i,
integer  l,
integer  m,
complex*16  h44,
complex*16  h33,
complex*16  h43h34,
complex*16, dimension( * )  buf,
integer  lwork 
)

Definition at line 1 of file pzlaconsb.f.

3*
4* -- ScaLAPACK routine (version 1.7) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6* and University of California, Berkeley.
7* July 31, 2001
8*
9* .. Scalar Arguments ..
10 INTEGER I, L, LWORK, M
11 COMPLEX*16 H33, H43H34, H44
12* ..
13* .. Array Arguments ..
14 INTEGER DESCA( * )
15 COMPLEX*16 A( * ), BUF( * )
16* ..
17*
18* Purpose
19* =======
20*
21* PZLACONSB 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) COMPLEX*16 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) COMPLEX*16
109* These three values are for the double shift QR iteration.
110*
111* BUF (local output) COMPLEX*16 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 ZLAHQR, 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* Further Details
153* ===============
154*
155* Implemented by: M. Fahey, May 28, 1999
156*
157* =====================================================================
158*
159* .. Parameters ..
160 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
161 $ LLD_, MB_, M_, NB_, N_, RSRC_
162 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
163 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
164 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
165* ..
166* .. Local Scalars ..
167 INTEGER CONTXT, DOWN, HBL, IBUF1, IBUF2, IBUF3, IBUF4,
168 $ IBUF5, ICOL1, II, IRCV1, IRCV2, IRCV3, IRCV4,
169 $ IRCV5, IROW1, ISRC, ISTR1, ISTR2, ISTR3, ISTR4,
170 $ ISTR5, JJ, JSRC, LDA, LEFT, MODKM1, MYCOL,
171 $ MYROW, NPCOL, NPROW, NUM, RIGHT, UP
172 DOUBLE PRECISION S, TST1, ULP
173 COMPLEX*16 CDUM, H00, H10, H11, H12, H21, H22, H33S, H44S,
174 $ V1, V2, V3
175* ..
176* .. External Functions ..
177 INTEGER ILCM
178 DOUBLE PRECISION PDLAMCH
179 EXTERNAL ilcm, pdlamch
180* ..
181* .. External Subroutines ..
182 EXTERNAL blacs_gridinfo, igamx2d, infog2l, pxerbla,
183 $ zgerv2d, zgesd2d
184* ..
185* .. Intrinsic Functions ..
186 INTRINSIC abs, dble, dimag, mod
187* ..
188* .. Statement Functions ..
189 DOUBLE PRECISION CABS1
190* ..
191* .. Statement Function definitions ..
192 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
193* ..
194* .. Executable Statements ..
195*
196 hbl = desca( mb_ )
197 contxt = desca( ctxt_ )
198 lda = desca( lld_ )
199 ulp = pdlamch( contxt, 'PRECISION' )
200 CALL blacs_gridinfo( contxt, nprow, npcol, myrow, mycol )
201 left = mod( mycol+npcol-1, npcol )
202 right = mod( mycol+1, npcol )
203 up = mod( myrow+nprow-1, nprow )
204 down = mod( myrow+1, nprow )
205 num = nprow*npcol
206*
207* BUFFER1 starts at BUF(ISTR1+1) and will contain IBUF1 elements
208* BUFFER2 starts at BUF(ISTR2+1) and will contain IBUF2 elements
209* BUFFER3 starts at BUF(ISTR3+1) and will contain IBUF3 elements
210* BUFFER4 starts at BUF(ISTR4+1) and will contain IBUF4 elements
211* BUFFER5 starts at BUF(ISTR5+1) and will contain IBUF5 elements
212*
213 istr1 = 0
214 istr2 = ( ( i-l-1 ) / hbl )
215 IF( istr2*hbl.LT.( i-l-1 ) )
216 $ istr2 = istr2 + 1
217 ii = istr2 / ilcm( nprow, npcol )
218 IF( ii*ilcm( nprow, npcol ).LT.istr2 ) THEN
219 istr2 = ii + 1
220 ELSE
221 istr2 = ii
222 END IF
223 IF( lwork.LT.7*istr2 ) THEN
224 CALL pxerbla( contxt, 'PZLACONSB', 10 )
225 RETURN
226 END IF
227 istr3 = 3*istr2
228 istr4 = istr3 + istr2
229 istr5 = istr3 + istr3
230 CALL infog2l( i-2, i-2, desca, nprow, npcol, myrow, mycol, irow1,
231 $ icol1, ii, jj )
232 modkm1 = mod( i-3+hbl, hbl )
233*
234* Copy our relevant pieces of triadiagonal that we owe into
235* 5 buffers to send to whomever owns H(M,M) as M moves diagonally
236* up the tridiagonal
237*
238 ibuf1 = 0
239 ibuf2 = 0
240 ibuf3 = 0
241 ibuf4 = 0
242 ibuf5 = 0
243 ircv1 = 0
244 ircv2 = 0
245 ircv3 = 0
246 ircv4 = 0
247 ircv5 = 0
248 DO 10 m = i - 2, l, -1
249 IF( ( modkm1.EQ.0 ) .AND. ( down.EQ.ii ) .AND.
250 $ ( right.EQ.jj ) .AND. ( m.GT.l ) ) THEN
251*
252* We must pack H(M-1,M-1) and send it diagonal down
253*
254 IF( ( down.NE.myrow ) .OR. ( right.NE.mycol ) ) THEN
255 CALL infog2l( m-1, m-1, desca, nprow, npcol, myrow,
256 $ mycol, irow1, icol1, isrc, jsrc )
257 ibuf1 = ibuf1 + 1
258 buf( istr1+ibuf1 ) = a( ( icol1-1 )*lda+irow1 )
259 END IF
260 END IF
261 IF( ( modkm1.EQ.0 ) .AND. ( myrow.EQ.ii ) .AND.
262 $ ( right.EQ.jj ) .AND. ( m.GT.l ) ) THEN
263*
264* We must pack H(M ,M-1) and send it right
265*
266 IF( npcol.GT.1 ) THEN
267 CALL infog2l( m, m-1, desca, nprow, npcol, myrow, mycol,
268 $ irow1, icol1, isrc, jsrc )
269 ibuf5 = ibuf5 + 1
270 buf( istr5+ibuf5 ) = a( ( icol1-1 )*lda+irow1 )
271 END IF
272 END IF
273 IF( ( modkm1.EQ.hbl-1 ) .AND. ( up.EQ.ii ) .AND.
274 $ ( mycol.EQ.jj ) ) THEN
275*
276* We must pack H(M+1,M) and send it up
277*
278 IF( nprow.GT.1 ) THEN
279 CALL infog2l( m+1, m, desca, nprow, npcol, myrow, mycol,
280 $ irow1, icol1, isrc, jsrc )
281 ibuf2 = ibuf2 + 1
282 buf( istr2+ibuf2 ) = a( ( icol1-1 )*lda+irow1 )
283 END IF
284 END IF
285 IF( ( modkm1.EQ.hbl-1 ) .AND. ( myrow.EQ.ii ) .AND.
286 $ ( left.EQ.jj ) ) THEN
287*
288* We must pack H(M ,M+1) and send it left
289*
290 IF( npcol.GT.1 ) THEN
291 CALL infog2l( m, m+1, desca, nprow, npcol, myrow, mycol,
292 $ irow1, icol1, isrc, jsrc )
293 ibuf3 = ibuf3 + 1
294 buf( istr3+ibuf3 ) = a( ( icol1-1 )*lda+irow1 )
295 END IF
296 END IF
297 IF( ( modkm1.EQ.hbl-1 ) .AND. ( up.EQ.ii ) .AND.
298 $ ( left.EQ.jj ) ) THEN
299*
300* We must pack H(M+1,M+1) & H(M+2,M+1) and send it
301* diagonally up
302*
303 IF( ( up.NE.myrow ) .OR. ( left.NE.mycol ) ) THEN
304 CALL infog2l( m+1, m+1, desca, nprow, npcol, myrow,
305 $ mycol, irow1, icol1, isrc, jsrc )
306 ibuf4 = ibuf4 + 2
307 buf( istr4+ibuf4-1 ) = a( ( icol1-1 )*lda+irow1 )
308 buf( istr4+ibuf4 ) = a( ( icol1-1 )*lda+irow1+1 )
309 END IF
310 END IF
311 IF( ( modkm1.EQ.hbl-2 ) .AND. ( up.EQ.ii ) .AND.
312 $ ( mycol.EQ.jj ) ) THEN
313*
314* We must pack H(M+2,M+1) and send it up
315*
316 IF( nprow.GT.1 ) THEN
317 CALL infog2l( m+2, m+1, desca, nprow, npcol, myrow,
318 $ mycol, irow1, icol1, isrc, jsrc )
319 ibuf2 = ibuf2 + 1
320 buf( istr2+ibuf2 ) = a( ( icol1-1 )*lda+irow1 )
321 END IF
322 END IF
323*
324* Add up the receives
325*
326 IF( ( myrow.EQ.ii ) .AND. ( mycol.EQ.jj ) ) THEN
327 IF( ( modkm1.EQ.0 ) .AND. ( m.GT.l ) .AND.
328 $ ( ( nprow.GT.1 ) .OR. ( npcol.GT.1 ) ) ) THEN
329*
330* We must receive H(M-1,M-1) from diagonal up
331*
332 ircv1 = ircv1 + 1
333 END IF
334 IF( ( modkm1.EQ.0 ) .AND. ( npcol.GT.1 ) .AND. ( m.GT.l ) )
335 $ THEN
336*
337* We must receive H(M ,M-1) from left
338*
339 ircv5 = ircv5 + 1
340 END IF
341 IF( ( modkm1.EQ.hbl-1 ) .AND. ( nprow.GT.1 ) ) THEN
342*
343* We must receive H(M+1,M ) from down
344*
345 ircv2 = ircv2 + 1
346 END IF
347 IF( ( modkm1.EQ.hbl-1 ) .AND. ( npcol.GT.1 ) ) THEN
348*
349* We must receive H(M ,M+1) from right
350*
351 ircv3 = ircv3 + 1
352 END IF
353 IF( ( modkm1.EQ.hbl-1 ) .AND.
354 $ ( ( nprow.GT.1 ) .OR. ( npcol.GT.1 ) ) ) THEN
355*
356* We must receive H(M+1:M+2,M+1) from diagonal down
357*
358 ircv4 = ircv4 + 2
359 END IF
360 IF( ( modkm1.EQ.hbl-2 ) .AND. ( nprow.GT.1 ) ) THEN
361*
362* We must receive H(M+2,M+1) from down
363*
364 ircv2 = ircv2 + 1
365 END IF
366 END IF
367*
368* Possibly change owners (occurs only when MOD(M-1,HBL) = 0)
369*
370 IF( modkm1.EQ.0 ) THEN
371 ii = ii - 1
372 jj = jj - 1
373 IF( ii.LT.0 )
374 $ ii = nprow - 1
375 IF( jj.LT.0 )
376 $ jj = npcol - 1
377 END IF
378 modkm1 = modkm1 - 1
379 IF( modkm1.LT.0 )
380 $ modkm1 = hbl - 1
381 10 CONTINUE
382*
383*
384* Send data on to the appropriate node if there is any data to send
385*
386 IF( ibuf1.GT.0 ) THEN
387 CALL zgesd2d( contxt, ibuf1, 1, buf( istr1+1 ), ibuf1, down,
388 $ right )
389 END IF
390 IF( ibuf2.GT.0 ) THEN
391 CALL zgesd2d( contxt, ibuf2, 1, buf( istr2+1 ), ibuf2, up,
392 $ mycol )
393 END IF
394 IF( ibuf3.GT.0 ) THEN
395 CALL zgesd2d( contxt, ibuf3, 1, buf( istr3+1 ), ibuf3, myrow,
396 $ left )
397 END IF
398 IF( ibuf4.GT.0 ) THEN
399 CALL zgesd2d( contxt, ibuf4, 1, buf( istr4+1 ), ibuf4, up,
400 $ left )
401 END IF
402 IF( ibuf5.GT.0 ) THEN
403 CALL zgesd2d( contxt, ibuf5, 1, buf( istr5+1 ), ibuf5, myrow,
404 $ right )
405 END IF
406*
407* Receive appropriate data if there is any
408*
409 IF( ircv1.GT.0 ) THEN
410 CALL zgerv2d( contxt, ircv1, 1, buf( istr1+1 ), ircv1, up,
411 $ left )
412 END IF
413 IF( ircv2.GT.0 ) THEN
414 CALL zgerv2d( contxt, ircv2, 1, buf( istr2+1 ), ircv2, down,
415 $ mycol )
416 END IF
417 IF( ircv3.GT.0 ) THEN
418 CALL zgerv2d( contxt, ircv3, 1, buf( istr3+1 ), ircv3, myrow,
419 $ right )
420 END IF
421 IF( ircv4.GT.0 ) THEN
422 CALL zgerv2d( contxt, ircv4, 1, buf( istr4+1 ), ircv4, down,
423 $ right )
424 END IF
425 IF( ircv5.GT.0 ) THEN
426 CALL zgerv2d( contxt, ircv5, 1, buf( istr5+1 ), ircv5, myrow,
427 $ left )
428 END IF
429*
430* Start main loop
431*
432 ibuf1 = 0
433 ibuf2 = 0
434 ibuf3 = 0
435 ibuf4 = 0
436 ibuf5 = 0
437 CALL infog2l( i-2, i-2, desca, nprow, npcol, myrow, mycol, irow1,
438 $ icol1, ii, jj )
439 modkm1 = mod( i-3+hbl, hbl )
440 IF( ( myrow.EQ.ii ) .AND. ( mycol.EQ.jj ) .AND.
441 $ ( modkm1.NE.hbl-1 ) ) THEN
442 CALL infog2l( i-2, i-1, desca, nprow, npcol, myrow, mycol,
443 $ irow1, icol1, isrc, jsrc )
444 END IF
445*
446* Look for two consecutive small subdiagonal elements.
447*
448 DO 20 m = i - 2, l, -1
449*
450* Determine the effect of starting the double-shift QR
451* iteration at row M, and see if this would make H(M,M-1)
452* negligible.
453*
454 IF( ( myrow.EQ.ii ) .AND. ( mycol.EQ.jj ) ) THEN
455 IF( modkm1.EQ.0 ) THEN
456 h22 = a( ( icol1-1 )*lda+irow1+1 )
457 h11 = a( ( icol1-2 )*lda+irow1 )
458 v3 = a( ( icol1-1 )*lda+irow1+2 )
459 h21 = a( ( icol1-2 )*lda+irow1+1 )
460 h12 = a( ( icol1-1 )*lda+irow1 )
461 IF( m.GT.l ) THEN
462 IF( num.GT.1 ) THEN
463 ibuf1 = ibuf1 + 1
464 h00 = buf( istr1+ibuf1 )
465 ELSE
466 h00 = a( ( icol1-3 )*lda+irow1-1 )
467 END IF
468 IF( npcol.GT.1 ) THEN
469 ibuf5 = ibuf5 + 1
470 h10 = buf( istr5+ibuf5 )
471 ELSE
472 h10 = a( ( icol1-3 )*lda+irow1 )
473 END IF
474 END IF
475 END IF
476 IF( modkm1.EQ.hbl-1 ) THEN
477 CALL infog2l( m, m, desca, nprow, npcol, myrow, mycol,
478 $ irow1, icol1, isrc, jsrc )
479 h11 = a( ( icol1-1 )*lda+irow1 )
480 IF( num.GT.1 ) THEN
481 ibuf4 = ibuf4 + 2
482 h22 = buf( istr4+ibuf4-1 )
483 v3 = buf( istr4+ibuf4 )
484 ELSE
485 h22 = a( icol1*lda+irow1+1 )
486 v3 = a( ( icol1+1 )*lda+irow1+1 )
487 END IF
488 IF( nprow.GT.1 ) THEN
489 ibuf2 = ibuf2 + 1
490 h21 = buf( istr2+ibuf2 )
491 ELSE
492 h21 = a( ( icol1-1 )*lda+irow1+1 )
493 END IF
494 IF( npcol.GT.1 ) THEN
495 ibuf3 = ibuf3 + 1
496 h12 = buf( istr3+ibuf3 )
497 ELSE
498 h12 = a( icol1*lda+irow1 )
499 END IF
500 IF( m.GT.l ) THEN
501 h00 = a( ( icol1-2 )*lda+irow1-1 )
502 h10 = a( ( icol1-2 )*lda+irow1 )
503 END IF
504*
505* Adjust ICOL1 for next iteration where MODKM1=HBL-2
506*
507 icol1 = icol1 + 1
508 END IF
509 IF( modkm1.EQ.hbl-2 ) THEN
510 h22 = a( ( icol1-1 )*lda+irow1+1 )
511 h11 = a( ( icol1-2 )*lda+irow1 )
512 IF( nprow.GT.1 ) THEN
513 ibuf2 = ibuf2 + 1
514 v3 = buf( istr2+ibuf2 )
515 ELSE
516 v3 = a( ( icol1-1 )*lda+irow1+2 )
517 END IF
518 h21 = a( ( icol1-2 )*lda+irow1+1 )
519 h12 = a( ( icol1-1 )*lda+irow1 )
520 IF( m.GT.l ) THEN
521 h00 = a( ( icol1-3 )*lda+irow1-1 )
522 h10 = a( ( icol1-3 )*lda+irow1 )
523 END IF
524 END IF
525 IF( ( modkm1.LT.hbl-2 ) .AND. ( modkm1.GT.0 ) ) THEN
526 h22 = a( ( icol1-1 )*lda+irow1+1 )
527 h11 = a( ( icol1-2 )*lda+irow1 )
528 v3 = a( ( icol1-1 )*lda+irow1+2 )
529 h21 = a( ( icol1-2 )*lda+irow1+1 )
530 h12 = a( ( icol1-1 )*lda+irow1 )
531 IF( m.GT.l ) THEN
532 h00 = a( ( icol1-3 )*lda+irow1-1 )
533 h10 = a( ( icol1-3 )*lda+irow1 )
534 END IF
535 END IF
536 h44s = h44 - h11
537 h33s = h33 - h11
538 v1 = ( h33s*h44s-h43h34 ) / h21 + h12
539 v2 = h22 - h11 - h33s - h44s
540 s = cabs1( v1 ) + cabs1( v2 ) + cabs1( v3 )
541 v1 = v1 / s
542 v2 = v2 / s
543 v3 = v3 / s
544 IF( m.EQ.l )
545 $ GO TO 30
546 tst1 = cabs1( v1 )*( cabs1( h00 )+cabs1( h11 )+
547 $ cabs1( h22 ) )
548 IF( cabs1( h10 )*( cabs1( v2 )+cabs1( v3 ) ).LE.ulp*tst1 )
549 $ GO TO 30
550*
551* Slide indices diagonally up one for next iteration
552*
553 irow1 = irow1 - 1
554 icol1 = icol1 - 1
555 END IF
556 IF( m.EQ.l ) THEN
557*
558* Stop regardless of which node we are
559*
560 GO TO 30
561 END IF
562*
563* Possibly change owners if on border
564*
565 IF( modkm1.EQ.0 ) THEN
566 ii = ii - 1
567 jj = jj - 1
568 IF( ii.LT.0 )
569 $ ii = nprow - 1
570 IF( jj.LT.0 )
571 $ jj = npcol - 1
572 END IF
573 modkm1 = modkm1 - 1
574 IF( modkm1.LT.0 )
575 $ modkm1 = hbl - 1
576 20 CONTINUE
577 30 CONTINUE
578*
579 CALL igamx2d( contxt, 'ALL', ' ', 1, 1, m, 1, l, l, -1, -1, -1 )
580*
581 RETURN
582*
583* End of PZLACONSB
584*
ilcm
integer function ilcm(m, n)
Definition ilcm.f:2
infog2l
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)
Definition infog2l.f:3
pdlamch
double precision function pdlamch(ictxt, cmach)
Definition pdblastst.f:6769
pxerbla
subroutine pxerbla(ictxt, srname, info)
Definition pxerbla.f:2
Here is the call graph for this function:
Here is the caller graph for this function: