Annotation of rpl/lapack/lapack/zungbr.f, revision 1.19

1.9       bertrand    1: *> \brief \b ZUNGBR
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.16      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.9       bertrand    7: *
                      8: *> \htmlonly
1.16      bertrand    9: *> Download ZUNGBR + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungbr.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungbr.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungbr.f">
1.9       bertrand   15: *> [TXT]</a>
1.16      bertrand   16: *> \endhtmlonly
1.9       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
1.16      bertrand   22: *
1.9       bertrand   23: *       .. Scalar Arguments ..
                     24: *       CHARACTER          VECT
                     25: *       INTEGER            INFO, K, LDA, LWORK, M, N
                     26: *       ..
                     27: *       .. Array Arguments ..
                     28: *       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
                     29: *       ..
1.16      bertrand   30: *
1.9       bertrand   31: *
                     32: *> \par Purpose:
                     33: *  =============
                     34: *>
                     35: *> \verbatim
                     36: *>
                     37: *> ZUNGBR generates one of the complex unitary matrices Q or P**H
                     38: *> determined by ZGEBRD when reducing a complex matrix A to bidiagonal
                     39: *> form: A = Q * B * P**H.  Q and P**H are defined as products of
                     40: *> elementary reflectors H(i) or G(i) respectively.
                     41: *>
                     42: *> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
                     43: *> is of order M:
                     44: *> if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n
                     45: *> columns of Q, where m >= n >= k;
                     46: *> if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an
                     47: *> M-by-M matrix.
                     48: *>
                     49: *> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H
                     50: *> is of order N:
                     51: *> if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m
                     52: *> rows of P**H, where n >= m >= k;
                     53: *> if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as
                     54: *> an N-by-N matrix.
                     55: *> \endverbatim
                     56: *
                     57: *  Arguments:
                     58: *  ==========
                     59: *
                     60: *> \param[in] VECT
                     61: *> \verbatim
                     62: *>          VECT is CHARACTER*1
                     63: *>          Specifies whether the matrix Q or the matrix P**H is
                     64: *>          required, as defined in the transformation applied by ZGEBRD:
                     65: *>          = 'Q':  generate Q;
                     66: *>          = 'P':  generate P**H.
                     67: *> \endverbatim
                     68: *>
                     69: *> \param[in] M
                     70: *> \verbatim
                     71: *>          M is INTEGER
                     72: *>          The number of rows of the matrix Q or P**H to be returned.
                     73: *>          M >= 0.
                     74: *> \endverbatim
                     75: *>
                     76: *> \param[in] N
                     77: *> \verbatim
                     78: *>          N is INTEGER
                     79: *>          The number of columns of the matrix Q or P**H to be returned.
                     80: *>          N >= 0.
                     81: *>          If VECT = 'Q', M >= N >= min(M,K);
                     82: *>          if VECT = 'P', N >= M >= min(N,K).
                     83: *> \endverbatim
                     84: *>
                     85: *> \param[in] K
                     86: *> \verbatim
                     87: *>          K is INTEGER
                     88: *>          If VECT = 'Q', the number of columns in the original M-by-K
                     89: *>          matrix reduced by ZGEBRD.
                     90: *>          If VECT = 'P', the number of rows in the original K-by-N
                     91: *>          matrix reduced by ZGEBRD.
                     92: *>          K >= 0.
                     93: *> \endverbatim
                     94: *>
                     95: *> \param[in,out] A
                     96: *> \verbatim
                     97: *>          A is COMPLEX*16 array, dimension (LDA,N)
                     98: *>          On entry, the vectors which define the elementary reflectors,
                     99: *>          as returned by ZGEBRD.
                    100: *>          On exit, the M-by-N matrix Q or P**H.
                    101: *> \endverbatim
                    102: *>
                    103: *> \param[in] LDA
                    104: *> \verbatim
                    105: *>          LDA is INTEGER
                    106: *>          The leading dimension of the array A. LDA >= M.
                    107: *> \endverbatim
                    108: *>
                    109: *> \param[in] TAU
                    110: *> \verbatim
                    111: *>          TAU is COMPLEX*16 array, dimension
                    112: *>                                (min(M,K)) if VECT = 'Q'
                    113: *>                                (min(N,K)) if VECT = 'P'
                    114: *>          TAU(i) must contain the scalar factor of the elementary
                    115: *>          reflector H(i) or G(i), which determines Q or P**H, as
                    116: *>          returned by ZGEBRD in its array argument TAUQ or TAUP.
                    117: *> \endverbatim
                    118: *>
                    119: *> \param[out] WORK
                    120: *> \verbatim
                    121: *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
                    122: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
                    123: *> \endverbatim
                    124: *>
                    125: *> \param[in] LWORK
                    126: *> \verbatim
                    127: *>          LWORK is INTEGER
                    128: *>          The dimension of the array WORK. LWORK >= max(1,min(M,N)).
                    129: *>          For optimum performance LWORK >= min(M,N)*NB, where NB
                    130: *>          is the optimal blocksize.
                    131: *>
                    132: *>          If LWORK = -1, then a workspace query is assumed; the routine
                    133: *>          only calculates the optimal size of the WORK array, returns
                    134: *>          this value as the first entry of the WORK array, and no error
                    135: *>          message related to LWORK is issued by XERBLA.
                    136: *> \endverbatim
                    137: *>
                    138: *> \param[out] INFO
                    139: *> \verbatim
                    140: *>          INFO is INTEGER
                    141: *>          = 0:  successful exit
                    142: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
                    143: *> \endverbatim
                    144: *
                    145: *  Authors:
                    146: *  ========
                    147: *
1.16      bertrand  148: *> \author Univ. of Tennessee
                    149: *> \author Univ. of California Berkeley
                    150: *> \author Univ. of Colorado Denver
                    151: *> \author NAG Ltd.
1.9       bertrand  152: *
                    153: *> \ingroup complex16GBcomputational
                    154: *
                    155: *  =====================================================================
1.1       bertrand  156:       SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
                    157: *
1.19    ! bertrand  158: *  -- LAPACK computational routine --
1.1       bertrand  159: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    160: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    161: *
                    162: *     .. Scalar Arguments ..
                    163:       CHARACTER          VECT
                    164:       INTEGER            INFO, K, LDA, LWORK, M, N
                    165: *     ..
                    166: *     .. Array Arguments ..
                    167:       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
                    168: *     ..
                    169: *
                    170: *  =====================================================================
                    171: *
                    172: *     .. Parameters ..
                    173:       COMPLEX*16         ZERO, ONE
                    174:       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
                    175:      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
                    176: *     ..
                    177: *     .. Local Scalars ..
                    178:       LOGICAL            LQUERY, WANTQ
1.11      bertrand  179:       INTEGER            I, IINFO, J, LWKOPT, MN
1.1       bertrand  180: *     ..
                    181: *     .. External Functions ..
                    182:       LOGICAL            LSAME
1.16      bertrand  183:       EXTERNAL           LSAME
1.1       bertrand  184: *     ..
                    185: *     .. External Subroutines ..
                    186:       EXTERNAL           XERBLA, ZUNGLQ, ZUNGQR
                    187: *     ..
                    188: *     .. Intrinsic Functions ..
                    189:       INTRINSIC          MAX, MIN
                    190: *     ..
                    191: *     .. Executable Statements ..
                    192: *
                    193: *     Test the input arguments
                    194: *
                    195:       INFO = 0
                    196:       WANTQ = LSAME( VECT, 'Q' )
                    197:       MN = MIN( M, N )
                    198:       LQUERY = ( LWORK.EQ.-1 )
                    199:       IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
                    200:          INFO = -1
                    201:       ELSE IF( M.LT.0 ) THEN
                    202:          INFO = -2
                    203:       ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
                    204:      $         K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
                    205:      $         MIN( N, K ) ) ) ) THEN
                    206:          INFO = -3
                    207:       ELSE IF( K.LT.0 ) THEN
                    208:          INFO = -4
                    209:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
                    210:          INFO = -6
                    211:       ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
                    212:          INFO = -9
                    213:       END IF
                    214: *
                    215:       IF( INFO.EQ.0 ) THEN
1.9       bertrand  216:          WORK( 1 ) = 1
1.1       bertrand  217:          IF( WANTQ ) THEN
1.9       bertrand  218:             IF( M.GE.K ) THEN
                    219:                CALL ZUNGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
                    220:             ELSE
                    221:                IF( M.GT.1 ) THEN
1.19    ! bertrand  222:                   CALL ZUNGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1,
        !           223:      $                         IINFO )
1.9       bertrand  224:                END IF
                    225:             END IF
1.1       bertrand  226:          ELSE
1.9       bertrand  227:             IF( K.LT.N ) THEN
                    228:                CALL ZUNGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
                    229:             ELSE
                    230:                IF( N.GT.1 ) THEN
1.19    ! bertrand  231:                   CALL ZUNGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1,
        !           232:      $                         IINFO )
1.9       bertrand  233:                END IF
                    234:             END IF
1.1       bertrand  235:          END IF
1.19    ! bertrand  236:          LWKOPT = INT( DBLE( WORK( 1 ) ) )
1.11      bertrand  237:          LWKOPT = MAX (LWKOPT, MN)
1.1       bertrand  238:       END IF
                    239: *
                    240:       IF( INFO.NE.0 ) THEN
                    241:          CALL XERBLA( 'ZUNGBR', -INFO )
                    242:          RETURN
                    243:       ELSE IF( LQUERY ) THEN
1.11      bertrand  244:          WORK( 1 ) = LWKOPT
1.1       bertrand  245:          RETURN
                    246:       END IF
                    247: *
                    248: *     Quick return if possible
                    249: *
                    250:       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
                    251:          WORK( 1 ) = 1
                    252:          RETURN
                    253:       END IF
                    254: *
                    255:       IF( WANTQ ) THEN
                    256: *
                    257: *        Form Q, determined by a call to ZGEBRD to reduce an m-by-k
                    258: *        matrix
                    259: *
                    260:          IF( M.GE.K ) THEN
                    261: *
                    262: *           If m >= k, assume m >= n >= k
                    263: *
                    264:             CALL ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
                    265: *
                    266:          ELSE
                    267: *
                    268: *           If m < k, assume m = n
                    269: *
                    270: *           Shift the vectors which define the elementary reflectors one
                    271: *           column to the right, and set the first row and column of Q
                    272: *           to those of the unit matrix
                    273: *
                    274:             DO 20 J = M, 2, -1
                    275:                A( 1, J ) = ZERO
                    276:                DO 10 I = J + 1, M
                    277:                   A( I, J ) = A( I, J-1 )
                    278:    10          CONTINUE
                    279:    20       CONTINUE
                    280:             A( 1, 1 ) = ONE
                    281:             DO 30 I = 2, M
                    282:                A( I, 1 ) = ZERO
                    283:    30       CONTINUE
                    284:             IF( M.GT.1 ) THEN
                    285: *
                    286: *              Form Q(2:m,2:m)
                    287: *
                    288:                CALL ZUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
                    289:      $                      LWORK, IINFO )
                    290:             END IF
                    291:          END IF
                    292:       ELSE
                    293: *
1.8       bertrand  294: *        Form P**H, determined by a call to ZGEBRD to reduce a k-by-n
1.1       bertrand  295: *        matrix
                    296: *
                    297:          IF( K.LT.N ) THEN
                    298: *
                    299: *           If k < n, assume k <= m <= n
                    300: *
                    301:             CALL ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
                    302: *
                    303:          ELSE
                    304: *
                    305: *           If k >= n, assume m = n
                    306: *
                    307: *           Shift the vectors which define the elementary reflectors one
1.8       bertrand  308: *           row downward, and set the first row and column of P**H to
1.1       bertrand  309: *           those of the unit matrix
                    310: *
                    311:             A( 1, 1 ) = ONE
                    312:             DO 40 I = 2, N
                    313:                A( I, 1 ) = ZERO
                    314:    40       CONTINUE
                    315:             DO 60 J = 2, N
                    316:                DO 50 I = J - 1, 2, -1
                    317:                   A( I, J ) = A( I-1, J )
                    318:    50          CONTINUE
                    319:                A( 1, J ) = ZERO
                    320:    60       CONTINUE
                    321:             IF( N.GT.1 ) THEN
                    322: *
1.8       bertrand  323: *              Form P**H(2:n,2:n)
1.1       bertrand  324: *
                    325:                CALL ZUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
                    326:      $                      LWORK, IINFO )
                    327:             END IF
                    328:          END IF
                    329:       END IF
                    330:       WORK( 1 ) = LWKOPT
                    331:       RETURN
                    332: *
                    333: *     End of ZUNGBR
                    334: *
                    335:       END

CVSweb interface <joel.bertrand@systella.fr>