1 SUBROUTINE pzunmbr( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA,
2 $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO )
10 CHARACTER SIDE, TRANS, VECT
11 INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N
14 INTEGER DESCA( * ), DESCC( * )
15 COMPLEX*16 A( * ), C( * ), TAU( * ), WORK( * )
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 )
290 LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
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
298 INTEGER IDUM1( 5 ), IDUM2( 5 )
306 INTEGER ILCM, INDXG2P, NUMROC
307 EXTERNAL ilcm, indxg2p, lsame, numroc
310 INTRINSIC dble, dcmplx, ichar,
max, mod
316 ictxt = desca( ctxt_ )
322 IF( nprow.EQ.-1 )
THEN
325 applyq = lsame( vect, 'q
' )
326 LEFT = LSAME( SIDE, 'l
' )
327 NOTRAN = LSAME( TRANS, 'n
' )
333.AND..GE..OR.
IF( ( APPLYQ NQK )
334.NOT..AND..GT.
$ ( APPLYQ NQK ) ) THEN
351 CALL CHK1MAT( M, 4, K, 6, IA, JA, DESCA, 10, INFO )
353 CALL CHK1MAT( K, 6, M, 4, IA, JA, DESCA, 10, INFO )
357.AND..GE..OR.
IF( ( APPLYQ NQK )
358.NOT..AND..GT.
$ ( APPLYQ NQK ) ) THEN
375 CALL CHK1MAT( N, 5, K, 6, IA, JA, DESCA, 10, INFO )
377 CALL CHK1MAT( K, 6, N, 5, IA, JA, DESCA, 10, INFO )
380 CALL CHK1MAT( M, 4, N, 5, IC, JC, DESCC, 15, INFO )
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_ ),
389 IAROW = INDXG2P( IAA, DESCA( MB_ ), MYROW, DESCA( RSRC_ ),
391 ICROW = INDXG2P( ICC, DESCC( MB_ ), MYROW, DESCC( RSRC_ ),
393 ICCOL = INDXG2P( JCC, DESCC( NB_ ), MYCOL, DESCC( CSRC_ ),
395 MPC0 = NUMROC( MI+IROFFC, DESCC( MB_ ), MYROW, ICROW,
397 NQC0 = NUMROC( NI+ICOFFC, DESCC( NB_ ), MYCOL, ICCOL,
402 LWMIN = MAX( ( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) )
403 $ / 2, ( MPC0 + NQC0 ) * DESCA( NB_ ) ) +
404 $ DESCA( NB_ ) * DESCA( NB_ )
406 NPA0 = NUMROC( NI+IROFFA, DESCA( MB_ ), MYROW, IAROW,
408 LCM = ILCM( NPROW, 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_ )
419 MQA0 = NUMROC( MI+ICOFFA, DESCA( NB_ ), MYCOL, IACOL,
421 LCM = ILCM( NPROW, NPCOL )
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_ )
429 LWMIN = MAX( ( DESCA( MB_ ) * ( DESCA( MB_ ) - 1 ) )
430 $ / 2, ( MPC0 + NQC0 ) * DESCA( MB_ ) ) +
431 $ DESCA( MB_ ) * DESCA( MB_ )
436 WORK( 1 ) = DCMPLX( DBLE( LWMIN ) )
437.EQ.
LQUERY = ( LWORK-1 )
438.NOT..AND..NOT.
IF( APPLYQ LSAME( VECT, 'p
' ) ) THEN
440.NOT..AND..NOT.
ELSE IF( LEFT LSAME( SIDE, 'r
' ) ) THEN
442.NOT..AND..NOT.
ELSE IF( NOTRAN LSAME( TRANS, 'c
' ) ) THEN
444.LT.
ELSE IF( K0 ) THEN
446.AND..NOT..AND.
ELSE IF( APPLYQ LEFT
447.NE.
$ DESCA( MB_ )DESCC( NB_ ) ) THEN
449.AND..AND..NE.
ELSE IF( APPLYQ LEFT IROFFAIROFFC ) THEN
451.AND..AND..NE.
ELSE IF( APPLYQ LEFT IAROWICROW ) THEN
453.NOT..AND..AND.
ELSE IF( APPLYQ LEFT
454.NE.
$ ICOFFAIROFFC ) THEN
456.NOT..AND..NOT..AND.
ELSE IF( APPLYQ LEFT
457.NE.
$ IACOLICCOL ) THEN
459.AND..NOT..AND.
ELSE IF( APPLYQ LEFT
460.NE.
$ IROFFAICOFFC ) THEN
462.NOT..AND..NOT..AND.
ELSE IF( APPLYQ LEFT
463.NE.
$ ICOFFAICOFFC ) THEN
465.AND..AND.
ELSE IF( APPLYQ LEFT
466.NE.
$ DESCA( MB_ )DESCC( MB_ ) ) THEN
468.NOT..AND..AND.
ELSE IF( APPLYQ LEFT
469.NE.
$ DESCA( MB_ )DESCC( MB_ ) ) THEN
471.AND..NOT..AND.
ELSE IF( APPLYQ LEFT
472.NE.
$ DESCA( MB_ )DESCC( NB_ ) ) THEN
474.NOT..AND..NOT..AND.
ELSE IF( APPLYQ LEFT
475.NE.
$ DESCA( NB_ )DESCC( NB_ ) ) THEN
477.LT..AND..NOT.
ELSE IF( LWORKLWMIN LQUERY ) THEN
483 IDUM1( 1 ) = ICHAR( 'q
' )
485 IDUM1( 1 ) = ICHAR( 'p
' )
489 IDUM1( 2 ) = ICHAR( 'l
' )
491 IDUM1( 2 ) = ICHAR( 'r
' )
495 IDUM1( 3 ) = ICHAR( 'n
' )
497 IDUM1( 3 ) = ICHAR( 'c
' )
502.EQ.
IF( LWORK-1 ) THEN
510 CALL PCHK2MAT( M, 4, K, 6, IA, JA, DESCA, 10, M, 4, N,
511 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
514 CALL PCHK2MAT( N, 5, K, 6, IA, JA, DESCA, 10, M, 4, N,
515 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
520 CALL PCHK2MAT( K, 6, M, 4, IA, JA, DESCA, 10, M, 4, N,
521 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
524 CALL PCHK2MAT( K, 6, N, 5, IA, JA, DESCA, 10, M, 4, N,
525 $ 5, IC, JC, DESCC, 15, 5, IDUM1, IDUM2,
532 CALL PXERBLA( ICTXT, 'pzunmbr', -INFO )
534 ELSE IF( LQUERY ) THEN
540.EQ..OR..EQ.
IF( M0 N0 )
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
557 CALL PZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A, IA+1, JA, DESCA,
558 $ TAU, C, ICC, JCC, DESCC, WORK, LWORK, IINFO )
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
579 CALL PZUNMLQ( SIDE, TRANST, MI, NI, NQ-1, A, IA, JA+1,
580 $ DESCA, TAU, C, ICC, JCC, DESCC, WORK, LWORK,
585 WORK( 1 ) = DCMPLX( DBLE( LWMIN ) )
subroutine pzunmqr(side, trans, m, n, k, a, ia, ja, desca, tau, c, ic, jc, descc, work, lwork, info)
subroutine pchk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
subroutine pzunmbr(vect, side, trans, m, n, k, a, ia, ja, desca, tau, c, ic, jc, descc, work, lwork, info)
subroutine pzunmlq(side, trans, m, n, k, a, ia, ja, desca, tau, c, ic, jc, descc, work, lwork, info)