Annotation of rpl/lapack/lapack/zungtr.f, revision 1.11

1.8       bertrand    1: *> \brief \b ZUNGTR
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
                      5: * Online html documentation available at 
                      6: *            http://www.netlib.org/lapack/explore-html/ 
                      7: *
                      8: *> \htmlonly
                      9: *> Download ZUNGTR + dependencies 
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungtr.f"> 
                     11: *> [TGZ]</a> 
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungtr.f"> 
                     13: *> [ZIP]</a> 
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungtr.f"> 
                     15: *> [TXT]</a>
                     16: *> \endhtmlonly 
                     17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
                     22: * 
                     23: *       .. Scalar Arguments ..
                     24: *       CHARACTER          UPLO
                     25: *       INTEGER            INFO, LDA, LWORK, N
                     26: *       ..
                     27: *       .. Array Arguments ..
                     28: *       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
                     29: *       ..
                     30: *  
                     31: *
                     32: *> \par Purpose:
                     33: *  =============
                     34: *>
                     35: *> \verbatim
                     36: *>
                     37: *> ZUNGTR generates a complex unitary matrix Q which is defined as the
                     38: *> product of n-1 elementary reflectors of order N, as returned by
                     39: *> ZHETRD:
                     40: *>
                     41: *> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
                     42: *>
                     43: *> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
                     44: *> \endverbatim
                     45: *
                     46: *  Arguments:
                     47: *  ==========
                     48: *
                     49: *> \param[in] UPLO
                     50: *> \verbatim
                     51: *>          UPLO is CHARACTER*1
                     52: *>          = 'U': Upper triangle of A contains elementary reflectors
                     53: *>                 from ZHETRD;
                     54: *>          = 'L': Lower triangle of A contains elementary reflectors
                     55: *>                 from ZHETRD.
                     56: *> \endverbatim
                     57: *>
                     58: *> \param[in] N
                     59: *> \verbatim
                     60: *>          N is INTEGER
                     61: *>          The order of the matrix Q. N >= 0.
                     62: *> \endverbatim
                     63: *>
                     64: *> \param[in,out] A
                     65: *> \verbatim
                     66: *>          A is COMPLEX*16 array, dimension (LDA,N)
                     67: *>          On entry, the vectors which define the elementary reflectors,
                     68: *>          as returned by ZHETRD.
                     69: *>          On exit, the N-by-N unitary matrix Q.
                     70: *> \endverbatim
                     71: *>
                     72: *> \param[in] LDA
                     73: *> \verbatim
                     74: *>          LDA is INTEGER
                     75: *>          The leading dimension of the array A. LDA >= N.
                     76: *> \endverbatim
                     77: *>
                     78: *> \param[in] TAU
                     79: *> \verbatim
                     80: *>          TAU is COMPLEX*16 array, dimension (N-1)
                     81: *>          TAU(i) must contain the scalar factor of the elementary
                     82: *>          reflector H(i), as returned by ZHETRD.
                     83: *> \endverbatim
                     84: *>
                     85: *> \param[out] WORK
                     86: *> \verbatim
                     87: *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
                     88: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
                     89: *> \endverbatim
                     90: *>
                     91: *> \param[in] LWORK
                     92: *> \verbatim
                     93: *>          LWORK is INTEGER
                     94: *>          The dimension of the array WORK. LWORK >= N-1.
                     95: *>          For optimum performance LWORK >= (N-1)*NB, where NB is
                     96: *>          the optimal blocksize.
                     97: *>
                     98: *>          If LWORK = -1, then a workspace query is assumed; the routine
                     99: *>          only calculates the optimal size of the WORK array, returns
                    100: *>          this value as the first entry of the WORK array, and no error
                    101: *>          message related to LWORK is issued by XERBLA.
                    102: *> \endverbatim
                    103: *>
                    104: *> \param[out] INFO
                    105: *> \verbatim
                    106: *>          INFO is INTEGER
                    107: *>          = 0:  successful exit
                    108: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
                    109: *> \endverbatim
                    110: *
                    111: *  Authors:
                    112: *  ========
                    113: *
                    114: *> \author Univ. of Tennessee 
                    115: *> \author Univ. of California Berkeley 
                    116: *> \author Univ. of Colorado Denver 
                    117: *> \author NAG Ltd. 
                    118: *
                    119: *> \date November 2011
                    120: *
                    121: *> \ingroup complex16OTHERcomputational
                    122: *
                    123: *  =====================================================================
1.1       bertrand  124:       SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
                    125: *
1.8       bertrand  126: *  -- LAPACK computational routine (version 3.4.0) --
1.1       bertrand  127: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    128: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8       bertrand  129: *     November 2011
1.1       bertrand  130: *
                    131: *     .. Scalar Arguments ..
                    132:       CHARACTER          UPLO
                    133:       INTEGER            INFO, LDA, LWORK, N
                    134: *     ..
                    135: *     .. Array Arguments ..
                    136:       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
                    137: *     ..
                    138: *
                    139: *  =====================================================================
                    140: *
                    141: *     .. Parameters ..
                    142:       COMPLEX*16         ZERO, ONE
                    143:       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
                    144:      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
                    145: *     ..
                    146: *     .. Local Scalars ..
                    147:       LOGICAL            LQUERY, UPPER
                    148:       INTEGER            I, IINFO, J, LWKOPT, NB
                    149: *     ..
                    150: *     .. External Functions ..
                    151:       LOGICAL            LSAME
                    152:       INTEGER            ILAENV
                    153:       EXTERNAL           LSAME, ILAENV
                    154: *     ..
                    155: *     .. External Subroutines ..
                    156:       EXTERNAL           XERBLA, ZUNGQL, ZUNGQR
                    157: *     ..
                    158: *     .. Intrinsic Functions ..
                    159:       INTRINSIC          MAX
                    160: *     ..
                    161: *     .. Executable Statements ..
                    162: *
                    163: *     Test the input arguments
                    164: *
                    165:       INFO = 0
                    166:       LQUERY = ( LWORK.EQ.-1 )
                    167:       UPPER = LSAME( UPLO, 'U' )
                    168:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    169:          INFO = -1
                    170:       ELSE IF( N.LT.0 ) THEN
                    171:          INFO = -2
                    172:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    173:          INFO = -4
                    174:       ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
                    175:          INFO = -7
                    176:       END IF
                    177: *
                    178:       IF( INFO.EQ.0 ) THEN
                    179:          IF( UPPER ) THEN
                    180:             NB = ILAENV( 1, 'ZUNGQL', ' ', N-1, N-1, N-1, -1 )
                    181:          ELSE
                    182:             NB = ILAENV( 1, 'ZUNGQR', ' ', N-1, N-1, N-1, -1 )
                    183:          END IF
                    184:          LWKOPT = MAX( 1, N-1 )*NB
                    185:          WORK( 1 ) = LWKOPT
                    186:       END IF
                    187: *
                    188:       IF( INFO.NE.0 ) THEN
                    189:          CALL XERBLA( 'ZUNGTR', -INFO )
                    190:          RETURN
                    191:       ELSE IF( LQUERY ) THEN
                    192:          RETURN
                    193:       END IF
                    194: *
                    195: *     Quick return if possible
                    196: *
                    197:       IF( N.EQ.0 ) THEN
                    198:          WORK( 1 ) = 1
                    199:          RETURN
                    200:       END IF
                    201: *
                    202:       IF( UPPER ) THEN
                    203: *
                    204: *        Q was determined by a call to ZHETRD with UPLO = 'U'
                    205: *
                    206: *        Shift the vectors which define the elementary reflectors one
                    207: *        column to the left, and set the last row and column of Q to
                    208: *        those of the unit matrix
                    209: *
                    210:          DO 20 J = 1, N - 1
                    211:             DO 10 I = 1, J - 1
                    212:                A( I, J ) = A( I, J+1 )
                    213:    10       CONTINUE
                    214:             A( N, J ) = ZERO
                    215:    20    CONTINUE
                    216:          DO 30 I = 1, N - 1
                    217:             A( I, N ) = ZERO
                    218:    30    CONTINUE
                    219:          A( N, N ) = ONE
                    220: *
                    221: *        Generate Q(1:n-1,1:n-1)
                    222: *
                    223:          CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
                    224: *
                    225:       ELSE
                    226: *
                    227: *        Q was determined by a call to ZHETRD with UPLO = 'L'.
                    228: *
                    229: *        Shift the vectors which define the elementary reflectors one
                    230: *        column to the right, and set the first row and column of Q to
                    231: *        those of the unit matrix
                    232: *
                    233:          DO 50 J = N, 2, -1
                    234:             A( 1, J ) = ZERO
                    235:             DO 40 I = J + 1, N
                    236:                A( I, J ) = A( I, J-1 )
                    237:    40       CONTINUE
                    238:    50    CONTINUE
                    239:          A( 1, 1 ) = ONE
                    240:          DO 60 I = 2, N
                    241:             A( I, 1 ) = ZERO
                    242:    60    CONTINUE
                    243:          IF( N.GT.1 ) THEN
                    244: *
                    245: *           Generate Q(2:n,2:n)
                    246: *
                    247:             CALL ZUNGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
                    248:      $                   LWORK, IINFO )
                    249:          END IF
                    250:       END IF
                    251:       WORK( 1 ) = LWKOPT
                    252:       RETURN
                    253: *
                    254: *     End of ZUNGTR
                    255: *
                    256:       END

CVSweb interface <joel.bertrand@systella.fr>