OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pzunmbr.f
Go to the documentation of this file.
1 SUBROUTINE pzunmbr( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA,
2 $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO )
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 CHARACTER SIDE, TRANS, VECT
11 INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N
12* ..
13* .. Array Arguments ..
14 INTEGER DESCA( * ), DESCC( * )
15 COMPLEX*16 A( * ), C( * ), TAU( * ), WORK( * )
16* ..
17*
18* Purpose
19* =======
20*
21* If VECT = 'Q', PZUNMBR overwrites the general complex distributed
22* M-by-N matrix sub( C ) = C(IC:IC+M-1,JC:JC+N-1) with
23*
24* SIDE = 'L' SIDE = 'R'
25* TRANS = 'N': Q * sub( C ) sub( C ) * Q
26* TRANS = 'C': Q**H * sub( C ) sub( C ) * Q**H
27*
28* If VECT = 'P', PZUNMBR overwrites sub( C ) with
29*
30* SIDE = 'L' SIDE = 'R'
31* TRANS = 'N': P * sub( C ) sub( C ) * P
32* TRANS = 'C': P**H * sub( C ) sub( C ) * P**H
33*
34* Here Q and P**H are the unitary distributed matrices determined by
35* PZGEBRD when reducing a complex distributed matrix A(IA:*,JA:*) to
36* bidiagonal form: A(IA:*,JA:*) = Q * B * P**H. Q and P**H are defined
37* as products of elementary reflectors H(i) and G(i) respectively.
38*
39* Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
40* order of the unitary matrix Q or P**H that is applied.
41*
42* If VECT = 'Q', A(IA:*,JA:*) is assumed to have been an NQ-by-K
43* matrix:
44* if nq >= k, Q = H(1) H(2) . . . H(k);
45* if nq < k, Q = H(1) H(2) . . . H(nq-1).
46*
47* If VECT = 'P', A(IA:*,JA:*) is assumed to have been a K-by-NQ
48* matrix:
49* if k < nq, P = G(1) G(2) . . . G(k);
50* if k >= nq, P = G(1) G(2) . . . G(nq-1).
51*
52* Notes
53* =====
54*
55* Each global data object is described by an associated description
56* vector. This vector stores the information required to establish
57* the mapping between an object element and its corresponding process
58* and memory location.
59*
60* Let A be a generic term for any 2D block cyclicly distributed array.
61* Such a global array has an associated description vector DESCA.
62* In the following comments, the character _ should be read as
63* "of the global array".
64*
65* NOTATION STORED IN EXPLANATION
66* --------------- -------------- --------------------------------------
67* DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
68* DTYPE_A = 1.
69* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
70* the BLACS process grid A is distribu-
71* ted over. The context itself is glo-
72* bal, but the handle (the integer
73* value) may vary.
74* M_A (global) DESCA( M_ ) The number of rows in the global
75* array A.
76* N_A (global) DESCA( N_ ) The number of columns in the global
77* array A.
78* MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
79* the rows of the array.
80* NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
81* the columns of the array.
82* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
83* row of the array A is distributed.
84* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
85* first column of the array A is
86* distributed.
87* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
88* array. LLD_A >= MAX(1,LOCr(M_A)).
89*
90* Let K be the number of rows or columns of a distributed matrix,
91* and assume that its process grid has dimension p x q.
92* LOCr( K ) denotes the number of elements of K that a process
93* would receive if K were distributed over the p processes of its
94* process column.
95* Similarly, LOCc( K ) denotes the number of elements of K that a
96* process would receive if K were distributed over the q processes of
97* its process row.
98* The values of LOCr() and LOCc() may be determined via a call to the
99* ScaLAPACK tool function, NUMROC:
100* LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
101* LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
102* An upper bound for these quantities may be computed by:
103* LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
104* LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
105*
106* Arguments
107* =========
108*
109* VECT (global input) CHARACTER
110* = 'Q': apply Q or Q**H;
111* = 'P': apply P or P**H.
112*
113* SIDE (global input) CHARACTER
114* = 'L': apply Q, Q**H, P or P**H from the Left;
115* = 'R': apply Q, Q**H, P or P**H from the Right.
116*
117* TRANS (global input) CHARACTER
118* = 'N': No transpose, apply Q or P;
119* = 'C': Conjugate transpose, apply Q**H or P**H.
120*
121* M (global input) INTEGER
122* The number of rows to be operated on i.e the number of rows
123* of the distributed submatrix sub( C ). M >= 0.
124*
125* N (global input) INTEGER
126* The number of columns to be operated on i.e the number of
127* columns of the distributed submatrix sub( C ). N >= 0.
128*
129* K (global input) INTEGER
130* If VECT = 'Q', the number of columns in the original
131* distributed matrix reduced by PZGEBRD.
132* If VECT = 'P', the number of rows in the original
133* distributed matrix reduced by PZGEBRD.
134* K >= 0.
135*
136* A (local input) COMPLEX*16 pointer into the local memory
137* to an array of dimension (LLD_A,LOCc(JA+MIN(NQ,K)-1)) if
138* VECT='Q', and (LLD_A,LOCc(JA+NQ-1)) if VECT = 'P'. NQ = M
139* if SIDE = 'L', and NQ = N otherwise. The vectors which
140* define the elementary reflectors H(i) and G(i), whose
141* products determine the matrices Q and P, as returned by
142* PZGEBRD.
143* If VECT = 'Q', LLD_A >= max(1,LOCr(IA+NQ-1));
144* if VECT = 'P', LLD_A >= max(1,LOCr(IA+MIN(NQ,K)-1)).
145*
146* IA (global input) INTEGER
147* The row index in the global array A indicating the first
148* row of sub( A ).
149*
150* JA (global input) INTEGER
151* The column index in the global array A indicating the
152* first column of sub( A ).
153*
154* DESCA (global and local input) INTEGER array of dimension DLEN_.
155* The array descriptor for the distributed matrix A.
156*
157* TAU (local input) COMPLEX*16 array, dimension
158* LOCc(JA+MIN(NQ,K)-1) if VECT = 'Q', LOCr(IA+MIN(NQ,K)-1) if
159* VECT = 'P', TAU(i) must contain the scalar factor of the
160* elementary reflector H(i) or G(i), which determines Q or P,
161* as returned by PDGEBRD in its array argument TAUQ or TAUP.
162* TAU is tied to the distributed matrix A.
163*
164* C (local input/local output) COMPLEX*16 pointer into the
165* local memory to an array of dimension (LLD_C,LOCc(JC+N-1)).
166* On entry, the local pieces of the distributed matrix sub(C).
167* On exit, if VECT='Q', sub( C ) is overwritten by Q*sub( C )
168* or Q'*sub( C ) or sub( C )*Q' or sub( C )*Q; if VECT='P,
169* sub( C ) is overwritten by P*sub( C ) or P'*sub( C ) or
170* sub( C )*P or sub( C )*P'.
171*
172* IC (global input) INTEGER
173* The row index in the global array C indicating the first
174* row of sub( C ).
175*
176* JC (global input) INTEGER
177* The column index in the global array C indicating the
178* first column of sub( C ).
179*
180* DESCC (global and local input) INTEGER array of dimension DLEN_.
181* The array descriptor for the distributed matrix C.
182*
183* WORK (local workspace/local output) COMPLEX*16 array,
184* dimension (LWORK)
185* On exit, WORK(1) returns the minimal and optimal LWORK.
186*
187* LWORK (local or global input) INTEGER
188* The dimension of the array WORK.
189* LWORK is local input and must be at least
190* If SIDE = 'L',
191* NQ = M;
192* if( (VECT = 'Q' and NQ >= K) or (VECT <> 'Q' and NQ > K) ),
193* IAA=IA; JAA=JA; MI=M; NI=N; ICC=IC; JCC=JC;
194* else
195* IAA=IA+1; JAA=JA; MI=M-1; NI=N; ICC=IC+1; JCC=JC;
196* end if
197* else if SIDE = 'R',
198* NQ = N;
199* if( (VECT = 'Q' and NQ >= K) or (VECT <> 'Q' and NQ > K) ),
200* IAA=IA; JAA=JA; MI=M; NI=N; ICC=IC; JCC=JC;
201* else
202* IAA=IA; JAA=JA+1; MI=M; NI=N-1; ICC=IC; JCC=JC+1;
203* end if
204* end if
205*
206* If VECT = 'Q',
207* If SIDE = 'L',
208* LWORK >= MAX( (NB_A*(NB_A-1))/2, (NqC0 + MpC0)*NB_A ) +
209* NB_A * NB_A
210* else if SIDE = 'R',
211* LWORK >= MAX( (NB_A*(NB_A-1))/2, ( NqC0 + MAX( NpA0 +
212* NUMROC( NUMROC( NI+ICOFFC, NB_A, 0, 0, NPCOL ),
213* NB_A, 0, 0, LCMQ ), MpC0 ) )*NB_A ) +
214* NB_A * NB_A
215* end if
216* else if VECT <> 'Q',
217* if SIDE = 'L',
218* LWORK >= MAX( (MB_A*(MB_A-1))/2, ( MpC0 + MAX( MqA0 +
219* NUMROC( NUMROC( MI+IROFFC, MB_A, 0, 0, NPROW ),
220* MB_A, 0, 0, LCMP ), NqC0 ) )*MB_A ) +
221* MB_A * MB_A
222* else if SIDE = 'R',
223* LWORK >= MAX( (MB_A*(MB_A-1))/2, (MpC0 + NqC0)*MB_A ) +
224* MB_A * MB_A
225* end if
226* end if
227*
228* where LCMP = LCM / NPROW, LCMQ = LCM / NPCOL, with
229* LCM = ICLM( NPROW, NPCOL ),
230*
231* IROFFA = MOD( IAA-1, MB_A ), ICOFFA = MOD( JAA-1, NB_A ),
232* IAROW = INDXG2P( IAA, MB_A, MYROW, RSRC_A, NPROW ),
233* IACOL = INDXG2P( JAA, NB_A, MYCOL, CSRC_A, NPCOL ),
234* MqA0 = NUMROC( MI+ICOFFA, NB_A, MYCOL, IACOL, NPCOL ),
235* NpA0 = NUMROC( NI+IROFFA, MB_A, MYROW, IAROW, NPROW ),
236*
237* IROFFC = MOD( ICC-1, MB_C ), ICOFFC = MOD( JCC-1, NB_C ),
238* ICROW = INDXG2P( ICC, MB_C, MYROW, RSRC_C, NPROW ),
239* ICCOL = INDXG2P( JCC, NB_C, MYCOL, CSRC_C, NPCOL ),
240* MpC0 = NUMROC( MI+IROFFC, MB_C, MYROW, ICROW, NPROW ),
241* NqC0 = NUMROC( NI+ICOFFC, NB_C, MYCOL, ICCOL, NPCOL ),
242*
243* INDXG2P and NUMROC are ScaLAPACK tool functions;
244* MYROW, MYCOL, NPROW and NPCOL can be determined by calling
245* the subroutine BLACS_GRIDINFO.
246*
247* If LWORK = -1, then LWORK is global input and a workspace
248* query is assumed; the routine only calculates the minimum
249* and optimal size for all work arrays. Each of these
250* values is returned in the first entry of the corresponding
251* work array, and no error message is issued by PXERBLA.
252*
253*
254* INFO (global output) INTEGER
255* = 0: successful exit
256* < 0: If the i-th argument is an array and the j-entry had
257* an illegal value, then INFO = -(i*100+j), if the i-th
258* argument is a scalar and had an illegal value, then
259* INFO = -i.
260*
261* Alignment requirements
262* ======================
263*
264* The distributed submatrices A(IA:*, JA:*) and C(IC:IC+M-1,JC:JC+N-1)
265* must verify some alignment properties, namely the following
266* expressions should be true:
267*
268* If VECT = 'Q',
269* If SIDE = 'L',
270* ( MB_A.EQ.MB_C .AND. IROFFA.EQ.IROFFC .AND. IAROW.EQ.ICROW )
271* If SIDE = 'R',
272* ( MB_A.EQ.NB_C .AND. IROFFA.EQ.ICOFFC )
273* else
274* If SIDE = 'L',
275* ( MB_A.EQ.MB_C .AND. ICOFFA.EQ.IROFFC )
276* If SIDE = 'R',
277* ( NB_A.EQ.NB_C .AND. ICOFFA.EQ.ICOFFC .AND. IACOL.EQ.ICCOL )
278* end if
279*
280* =====================================================================
281*
282* .. Parameters ..
283 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
284 $ lld_, mb_, m_, nb_, n_, rsrc_
285 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
286 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
287 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
288* ..
289* .. Local Scalars ..
290 LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
291 CHARACTER TRANST
292 INTEGER IAA, IACOL, IAROW, ICC, ICCOL, ICOFFA, ICOFFC,
293 $ icrow, ictxt, iinfo, iroffa, iroffc, jaa, jcc,
294 $ lcm, lcmp, lcmq, lwmin, mi, mpc0, mqa0, mycol,
295 $ myrow, ni, npa0, npcol, nprow, nq, nqc0
296* ..
297* .. Local Arrays ..
298 INTEGER IDUM1( 5 ), IDUM2( 5 )
299* ..
300* .. External Subroutines ..
303* ..
304* .. External Functions ..
305 LOGICAL LSAME
306 INTEGER ILCM, INDXG2P, NUMROC
307 EXTERNAL ilcm, indxg2p, lsame, numroc
308* ..
309* .. Intrinsic Functions ..
310 INTRINSIC dble, dcmplx, ichar, max, mod
311* ..
312* .. Executable Statements ..
313*
314* Get grid parameters
315*
316 ictxt = desca( ctxt_ )
317 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
318*
319* Test the input parameters
320*
321 info = 0
322 IF( nprow.EQ.-1 ) THEN
323 info = -(1000+ctxt_)
324 ELSE
325 applyq = lsame( vect, 'q' )
326 LEFT = LSAME( SIDE, 'l' )
327 NOTRAN = LSAME( TRANS, 'n' )
328*
329* NQ is the order of Q or P
330*
331 IF( LEFT ) THEN
332 NQ = M
333.AND..GE..OR. IF( ( APPLYQ NQK )
334.NOT..AND..GT. $ ( APPLYQ NQK ) ) THEN
335 IAA = IA
336 JAA = JA
337 MI = M
338 NI = N
339 ICC = IC
340 JCC = JC
341 ELSE
342 IAA = IA + 1
343 JAA = JA
344 MI = M - 1
345 NI = N
346 ICC = IC + 1
347 JCC = JC
348 END IF
349*
350 IF( APPLYQ ) THEN
351 CALL CHK1MAT( M, 4, K, 6, IA, JA, DESCA, 10, INFO )
352 ELSE
353 CALL CHK1MAT( K, 6, M, 4, IA, JA, DESCA, 10, INFO )
354 END IF
355 ELSE
356 NQ = N
357.AND..GE..OR. IF( ( APPLYQ NQK )
358.NOT..AND..GT. $ ( APPLYQ NQK ) ) THEN
359 IAA = IA
360 JAA = JA
361 MI = M
362 NI = N
363 ICC = IC
364 JCC = JC
365 ELSE
366 IAA = IA
367 JAA = JA + 1
368 MI = M
369 NI = N - 1
370 ICC = IC
371 JCC = JC + 1
372 END IF
373*
374 IF( APPLYQ ) THEN
375 CALL CHK1MAT( N, 5, K, 6, IA, JA, DESCA, 10, INFO )
376 ELSE
377 CALL CHK1MAT( K, 6, N, 5, IA, JA, DESCA, 10, INFO )
378 END IF
379 END IF
380 CALL CHK1MAT( M, 4, N, 5, IC, JC, DESCC, 15, INFO )
381*
382.EQ. IF( INFO0 ) THEN
383 IROFFA = MOD( IAA-1, DESCA( MB_ ) )
384 ICOFFA = MOD( JAA-1, DESCA( NB_ ) )
385 IROFFC = MOD( ICC-1, DESCC( MB_ ) )
386 ICOFFC = MOD( JCC-1, DESCC( NB_ ) )
387 IACOL = INDXG2P( JAA, DESCA( NB_ ), MYCOL, DESCA( CSRC_ ),
388 $ NPCOL )
389 IAROW = INDXG2P( IAA, DESCA( MB_ ), MYROW, DESCA( RSRC_ ),
390 $ NPROW )
391 ICROW = INDXG2P( ICC, DESCC( MB_ ), MYROW, DESCC( RSRC_ ),
392 $ NPROW )
393 ICCOL = INDXG2P( JCC, DESCC( NB_ ), MYCOL, DESCC( CSRC_ ),
394 $ NPCOL )
395 MPC0 = NUMROC( MI+IROFFC, DESCC( MB_ ), MYROW, ICROW,
396 $ NPROW )
397 NQC0 = NUMROC( NI+ICOFFC, DESCC( NB_ ), MYCOL, ICCOL,
398 $ NPCOL )
399*
400 IF( APPLYQ ) THEN
401 IF( LEFT ) THEN
402 LWMIN = MAX( ( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) )
403 $ / 2, ( MPC0 + NQC0 ) * DESCA( NB_ ) ) +
404 $ DESCA( NB_ ) * DESCA( NB_ )
405 ELSE
406 NPA0 = NUMROC( NI+IROFFA, DESCA( MB_ ), MYROW, IAROW,
407 $ NPROW )
408 LCM = ILCM( NPROW, NPCOL )
409 LCMQ = LCM / NPCOL
410 LWMIN = MAX( ( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) )
411 $ / 2, ( NQC0 + MAX( NPA0 + NUMROC( NUMROC(
412 $ NI+ICOFFC, DESCA( NB_ ), 0, 0, NPCOL ),
413 $ DESCA( NB_ ), 0, 0, LCMQ ), MPC0 ) ) *
414 $ DESCA( NB_ ) ) + DESCA( NB_ ) * DESCA( NB_ )
415 END IF
416 ELSE
417*
418 IF( LEFT ) THEN
419 MQA0 = NUMROC( MI+ICOFFA, DESCA( NB_ ), MYCOL, IACOL,
420 $ NPCOL )
421 LCM = ILCM( NPROW, NPCOL )
422 LCMP = LCM / NPROW
423 LWMIN = MAX( ( DESCA( MB_ ) * ( DESCA( MB_ ) - 1 ) )
424 $ / 2, ( MPC0 + MAX( MQA0 + NUMROC( NUMROC(
425 $ MI+IROFFC, DESCA( MB_ ), 0, 0, NPROW ),
426 $ DESCA( MB_ ), 0, 0, LCMP ), NQC0 ) ) *
427 $ DESCA( MB_ ) ) + DESCA( MB_ ) * DESCA( MB_ )
428 ELSE
429 LWMIN = MAX( ( DESCA( MB_ ) * ( DESCA( MB_ ) - 1 ) )
430 $ / 2, ( MPC0 + NQC0 ) * DESCA( MB_ ) ) +
431 $ DESCA( MB_ ) * DESCA( MB_ )
432 END IF
433*
434 END IF
435*
436 WORK( 1 ) = DCMPLX( DBLE( LWMIN ) )
437.EQ. LQUERY = ( LWORK-1 )
438.NOT..AND..NOT. IF( APPLYQ LSAME( VECT, 'p' ) ) THEN
439 INFO = -1
440.NOT..AND..NOT. ELSE IF( LEFT LSAME( SIDE, 'r' ) ) THEN
441 INFO = -2
442.NOT..AND..NOT. ELSE IF( NOTRAN LSAME( TRANS, 'c' ) ) THEN
443 INFO = -3
444.LT. ELSE IF( K0 ) THEN
445 INFO = -6
446.AND..NOT..AND. ELSE IF( APPLYQ LEFT
447.NE. $ DESCA( MB_ )DESCC( NB_ ) ) THEN
448 INFO = -(1000+NB_)
449.AND..AND..NE. ELSE IF( APPLYQ LEFT IROFFAIROFFC ) THEN
450 INFO = -13
451.AND..AND..NE. ELSE IF( APPLYQ LEFT IAROWICROW ) THEN
452 INFO = -13
453.NOT..AND..AND. ELSE IF( APPLYQ LEFT
454.NE. $ ICOFFAIROFFC ) THEN
455 INFO = -13
456.NOT..AND..NOT..AND. ELSE IF( APPLYQ LEFT
457.NE. $ IACOLICCOL ) THEN
458 INFO = -14
459.AND..NOT..AND. ELSE IF( APPLYQ LEFT
460.NE. $ IROFFAICOFFC ) THEN
461 INFO = -14
462.NOT..AND..NOT..AND. ELSE IF( APPLYQ LEFT
463.NE. $ ICOFFAICOFFC ) THEN
464 INFO = -14
465.AND..AND. ELSE IF( APPLYQ LEFT
466.NE. $ DESCA( MB_ )DESCC( MB_ ) ) THEN
467 INFO = -(1500+MB_)
468.NOT..AND..AND. ELSE IF( APPLYQ LEFT
469.NE. $ DESCA( MB_ )DESCC( MB_ ) ) THEN
470 INFO = -(1500+MB_)
471.AND..NOT..AND. ELSE IF( APPLYQ LEFT
472.NE. $ DESCA( MB_ )DESCC( NB_ ) ) THEN
473 INFO = -(1500+NB_)
474.NOT..AND..NOT..AND. ELSE IF( APPLYQ LEFT
475.NE. $ DESCA( NB_ )DESCC( NB_ ) ) THEN
476 INFO = -(1500+NB_)
477.LT..AND..NOT. ELSE IF( LWORKLWMIN LQUERY ) THEN
478 INFO = -17
479 END IF
480 END IF
481*
482 IF( APPLYQ ) THEN
483 IDUM1( 1 ) = ICHAR( 'q' )
484 ELSE
485 IDUM1( 1 ) = ICHAR( 'p' )
486 END IF
487 IDUM2( 1 ) = 1
488 IF( LEFT ) THEN
489 IDUM1( 2 ) = ICHAR( 'l' )
490 ELSE
491 IDUM1( 2 ) = ICHAR( 'r' )
492 END IF
493 IDUM2( 2 ) = 2
494 IF( NOTRAN ) THEN
495 IDUM1( 3 ) = ICHAR( 'n' )
496 ELSE
497 IDUM1( 3 ) = ICHAR( 'c' )
498 END IF
499 IDUM2( 3 ) = 3
500 IDUM1( 4 ) = K
501 IDUM2( 4 ) = 6
502.EQ. IF( LWORK-1 ) THEN
503 IDUM1( 5 ) = -1
504 ELSE
505 IDUM1( 5 ) = 1
506 END IF
507 IDUM2( 5 ) = 17
508 IF( APPLYQ ) THEN
509 IF( LEFT ) THEN
510 CALL PCHK2MAT( M, 4, K, 6, IA, JA, DESCA, 10, M, 4, N,
511 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
512 $ INFO )
513 ELSE
514 CALL PCHK2MAT( N, 5, K, 6, IA, JA, DESCA, 10, M, 4, N,
515 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
516 $ INFO )
517 END IF
518 ELSE
519 IF( LEFT ) THEN
520 CALL PCHK2MAT( K, 6, M, 4, IA, JA, DESCA, 10, M, 4, N,
521 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
522 $ INFO )
523 ELSE
524 CALL PCHK2MAT( K, 6, N, 5, IA, JA, DESCA, 10, M, 4, N,
525 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
526 $ INFO )
527 END IF
528 END IF
529 END IF
530*
531.NE. IF( INFO0 ) THEN
532 CALL PXERBLA( ICTXT, 'pzunmbr', -INFO )
533 RETURN
534 ELSE IF( LQUERY ) THEN
535 RETURN
536 END IF
537*
538* Quick return if possible
539*
540.EQ..OR..EQ. IF( M0 N0 )
541 $ RETURN
542*
543 IF( APPLYQ ) THEN
544*
545* Apply Q
546*
547.GE. IF( NQK ) THEN
548*
549* Q was determined by a call to PZGEBRD with nq >= k
550*
551 CALL PZUNMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU,
552 $ C, IC, JC, DESCC, WORK, LWORK, IINFO )
553.GT. ELSE IF( NQ1 ) THEN
554*
555* Q was determined by a call to PZGEBRD with nq < k
556*
557 CALL PZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A, IA+1, JA, DESCA,
558 $ TAU, C, ICC, JCC, DESCC, WORK, LWORK, IINFO )
559 END IF
560 ELSE
561*
562* Apply P
563*
564 IF( NOTRAN ) THEN
565 TRANST = 'c'
566 ELSE
567 TRANST = 'n'
568 END IF
569.GT. IF( NQK ) THEN
570*
571* P was determined by a call to PZGEBRD with nq > k
572*
573 CALL PZUNMLQ( SIDE, TRANST, M, N, K, A, IA, JA, DESCA, TAU,
574 $ C, IC, JC, DESCC, WORK, LWORK, IINFO )
575.GT. ELSE IF( NQ1 ) THEN
576*
577* P was determined by a call to PZGEBRD with nq <= k
578*
579 CALL PZUNMLQ( SIDE, TRANST, MI, NI, NQ-1, A, IA, JA+1,
580 $ DESCA, TAU, C, ICC, JCC, DESCC, WORK, LWORK,
581 $ IINFO )
582 END IF
583 END IF
584*
585 WORK( 1 ) = DCMPLX( DBLE( LWMIN ) )
586*
587 RETURN
588*
589* End of PZUNMBR
590*
591 END
#define max(a, b)
Definition macros.h:21
subroutine chk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, info)
Definition mpi.f:1577
subroutine pxerbla(contxt, srname, info)
Definition mpi.f:1600
subroutine pzunmqr(side, trans, m, n, k, a, ia, ja, desca, tau, c, ic, jc, descc, work, lwork, info)
Definition mpi.f:1538
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754
subroutine pchk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
Definition pchkxmat.f:3
subroutine pzunmbr(vect, side, trans, m, n, k, a, ia, ja, desca, tau, c, ic, jc, descc, work, lwork, info)
Definition pzunmbr.f:3
subroutine pzunmlq(side, trans, m, n, k, a, ia, ja, desca, tau, c, ic, jc, descc, work, lwork, info)
Definition pzunmlq.f:3