ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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 ..
301  EXTERNAL blacs_gridinfo, chk1mat, pchk1mat, pxerbla,
302  $ pzunmlq, pzunmqr
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  IF( ( applyq .AND. nq.GE.k ) .OR.
334  $ ( .NOT.applyq .AND. nq.GT.k ) ) 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  IF( ( applyq .AND. nq.GE.k ) .OR.
358  $ ( .NOT.applyq .AND. nq.GT.k ) ) 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  IF( info.EQ.0 ) 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  lquery = ( lwork.EQ.-1 )
438  IF( .NOT.applyq .AND. .NOT.lsame( vect, 'P' ) ) THEN
439  info = -1
440  ELSE IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
441  info = -2
442  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
443  info = -3
444  ELSE IF( k.LT.0 ) THEN
445  info = -6
446  ELSE IF( applyq .AND. .NOT.left .AND.
447  $ desca( mb_ ).NE.descc( nb_ ) ) THEN
448  info = -(1000+nb_)
449  ELSE IF( applyq .AND. left .AND. iroffa.NE.iroffc ) THEN
450  info = -13
451  ELSE IF( applyq .AND. left .AND. iarow.NE.icrow ) THEN
452  info = -13
453  ELSE IF( .NOT.applyq .AND. left .AND.
454  $ icoffa.NE.iroffc ) THEN
455  info = -13
456  ELSE IF( .NOT.applyq .AND. .NOT.left .AND.
457  $ iacol.NE.iccol ) THEN
458  info = -14
459  ELSE IF( applyq .AND. .NOT.left .AND.
460  $ iroffa.NE.icoffc ) THEN
461  info = -14
462  ELSE IF( .NOT.applyq .AND. .NOT.left .AND.
463  $ icoffa.NE.icoffc ) THEN
464  info = -14
465  ELSE IF( applyq .AND. left .AND.
466  $ desca( mb_ ).NE.descc( mb_ ) ) THEN
467  info = -(1500+mb_)
468  ELSE IF( .NOT.applyq .AND. left .AND.
469  $ desca( mb_ ).NE.descc( mb_ ) ) THEN
470  info = -(1500+mb_)
471  ELSE IF( applyq .AND. .NOT.left .AND.
472  $ desca( mb_ ).NE.descc( nb_ ) ) THEN
473  info = -(1500+nb_)
474  ELSE IF( .NOT.applyq .AND. .NOT.left .AND.
475  $ desca( nb_ ).NE.descc( nb_ ) ) THEN
476  info = -(1500+nb_)
477  ELSE IF( lwork.LT.lwmin .AND. .NOT.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  IF( lwork.EQ.-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  IF( info.NE.0 ) 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  IF( m.EQ.0 .OR. n.EQ.0 )
541  $ RETURN
542 *
543  IF( applyq ) THEN
544 *
545 * Apply Q
546 *
547  IF( nq.GE.k ) 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  ELSE IF( nq.GT.1 ) 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  IF( nq.GT.k ) 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  ELSE IF( nq.GT.1 ) 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
pzunmlq
subroutine pzunmlq(SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, C, IC, JC, DESCC, WORK, LWORK, INFO)
Definition: pzunmlq.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
pzunmbr
subroutine pzunmbr(VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, C, IC, JC, DESCC, WORK, LWORK, INFO)
Definition: pzunmbr.f:3
pzunmqr
subroutine pzunmqr(SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, C, IC, JC, DESCC, WORK, LWORK, INFO)
Definition: pzunmqr.f:3
pchk1mat
subroutine pchk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:3
pchk2mat
subroutine pchk2mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, MB, MBPOS0, NB, NBPOS0, IB, JB, DESCB, DESCBPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:175
chk1mat
subroutine chk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, INFO)
Definition: chk1mat.f:3
pxerbla
subroutine pxerbla(ICTXT, SRNAME, INFO)
Definition: pxerbla.f:2