clattr.f

Go to the documentation of this file.

*> \brief \b CLATTR
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       SUBROUTINE CLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
*                          WORK, RWORK, INFO )
*
*       .. Scalar Arguments ..
*       CHARACTER          DIAG, TRANS, UPLO
*       INTEGER            IMAT, INFO, LDA, N
*       ..
*       .. Array Arguments ..
*       INTEGER            ISEED( 4 )
*       REAL               RWORK( * )
*       COMPLEX            A( LDA, * ), B( * ), WORK( * )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> CLATTR generates a triangular test matrix in 2-dimensional storage.
*> IMAT and UPLO uniquely specify the properties of the test matrix,
*> which is returned in the array A.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] IMAT
*> \verbatim
*>          IMAT is INTEGER
*>          An integer key describing which matrix to generate for this
*>          path.
*> \endverbatim
*>
*> \param[in] UPLO
*> \verbatim
*>          UPLO is CHARACTER*1
*>          Specifies whether the matrix A will be upper or lower
*>          triangular.
*>          = 'U':  Upper triangular
*>          = 'L':  Lower triangular
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*>          TRANS is CHARACTER*1
*>          Specifies whether the matrix or its transpose will be used.
*>          = 'N':  No transpose
*>          = 'T':  Transpose
*>          = 'C':  Conjugate transpose
*> \endverbatim
*>
*> \param[out] DIAG
*> \verbatim
*>          DIAG is CHARACTER*1
*>          Specifies whether or not the matrix A is unit triangular.
*>          = 'N':  Non-unit triangular
*>          = 'U':  Unit triangular
*> \endverbatim
*>
*> \param[in,out] ISEED
*> \verbatim
*>          ISEED is INTEGER array, dimension (4)
*>          The seed vector for the random number generator (used in
*>          CLATMS).  Modified on exit.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The order of the matrix to be generated.
*> \endverbatim
*>
*> \param[out] A
*> \verbatim
*>          A is COMPLEX array, dimension (LDA,N)
*>          The triangular matrix A.  If UPLO = 'U', the leading N x N
*>          upper triangular part of the array A contains the upper
*>          triangular matrix, and the strictly lower triangular part of
*>          A is not referenced.  If UPLO = 'L', the leading N x N lower
*>          triangular part of the array A contains the lower triangular
*>          matrix and the strictly upper triangular part of A is not
*>          referenced.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*>          LDA is INTEGER
*>          The leading dimension of the array A.  LDA >= max(1,N).
*> \endverbatim
*>
*> \param[out] B
*> \verbatim
*>          B is COMPLEX array, dimension (N)
*>          The right hand side vector, if IMAT > 10.
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is COMPLEX array, dimension (2*N)
*> \endverbatim
*>
*> \param[out] RWORK
*> \verbatim
*>          RWORK is REAL array, dimension (N)
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          = 0:  successful exit
*>          < 0:  if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex_lin
*
*  =====================================================================
      SUBROUTINE clattr( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
     $                   WORK, RWORK, INFO )
*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          DIAG, TRANS, UPLO
      INTEGER            IMAT, INFO, LDA, N
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 )
      REAL               RWORK( * )
      COMPLEX            A( LDA, * ), B( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE, TWO, ZERO
      parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            UPPER
      CHARACTER          DIST, TYPE
      CHARACTER*3        PATH
      INTEGER            I, IY, J, JCOUNT, KL, KU, MODE
      REAL               ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
     $                   sfac, smlnum, texp, tleft, tscal, ulp, unfl, x,
     $                   y, z
      COMPLEX            PLUS1, PLUS2, RA, RB, S, STAR1
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICAMAX
      REAL               SLAMCH, SLARND
      COMPLEX            CLARND
      EXTERNAL           lsame, icamax, slamch, slarnd, clarnd
*     ..
*     .. External Subroutines ..
      EXTERNAL           ccopy, clarnv, clatb4, clatms, crot, crotg,
     $                   csscal, cswap, slarnv
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, cmplx, conjg, max, real, sqrt
*     ..
*     .. Executable Statements ..
*
      path( 1: 1 ) = 'Complex precision'
      path( 2: 3 ) = 'TR'
      unfl = slamch( 'Safe minimum' )
      ulp = slamch( 'Epsilon' )*slamch( 'Base' )
      smlnum = unfl
      bignum = ( one-ulp ) / smlnum
      IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 ) THEN
         diag = 'U'
      ELSE
         diag = 'N'
      END IF
      info = 0
*
*     Quick return if N.LE.0.
*
      IF( n.LE.0 )
     $   RETURN
*
*     Call CLATB4 to set parameters for CLATMS.
*
      upper = lsame( uplo, 'U' )
      IF( upper ) THEN
         CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
     $                cndnum, dist )
      ELSE
         CALL clatb4( path, -imat, n, n, TYPE, kl, ku, anorm, mode,
     $                cndnum, dist )
      END IF
*
*     IMAT <= 6:  Non-unit triangular matrix
*
      IF( imat.LE.6 ) THEN
         CALL clatms( n, n, dist, iseed, TYPE, rwork, mode, cndnum,
     $                anorm, kl, ku, 'No packing', a, lda, work, info )
*
*     IMAT > 6:  Unit triangular matrix
*     The diagonal is deliberately set to something other than 1.
*
*     IMAT = 7:  Matrix is the identity
*
      ELSE IF( imat.EQ.7 ) THEN
         IF( upper ) THEN
            DO 20 j = 1, n
               DO 10 i = 1, j - 1
                  a( i, j ) = zero
   10          CONTINUE
               a( j, j ) = j
   20       CONTINUE
         ELSE
            DO 40 j = 1, n
               a( j, j ) = j
               DO 30 i = j + 1, n
                  a( i, j ) = zero
   30          CONTINUE
   40       CONTINUE
         END IF
*
*     IMAT > 7:  Non-trivial unit triangular matrix
*
*     Generate a unit triangular matrix T with condition CNDNUM by
*     forming a triangular matrix with known singular values and
*     filling in the zero entries with Givens rotations.
*
      ELSE IF( imat.LE.10 ) THEN
         IF( upper ) THEN
            DO 60 j = 1, n
               DO 50 i = 1, j - 1
                  a( i, j ) = zero
   50          CONTINUE
               a( j, j ) = j
   60       CONTINUE
         ELSE
            DO 80 j = 1, n
               a( j, j ) = j
               DO 70 i = j + 1, n
                  a( i, j ) = zero
   70          CONTINUE
   80       CONTINUE
         END IF
*
*        Since the trace of a unit triangular matrix is 1, the product
*        of its singular values must be 1.  Let s = sqrt(CNDNUM),
*        x = sqrt(s) - 1/sqrt(s), y = sqrt(2/(n-2))*x, and z = x**2.
*        The following triangular matrix has singular values s, 1, 1,
*        ..., 1, 1/s:
*
*        1  y  y  y  ...  y  y  z
*           1  0  0  ...  0  0  y
*              1  0  ...  0  0  y
*                 .  ...  .  .  .
*                     .   .  .  .
*                         1  0  y
*                            1  y
*                               1
*
*        To fill in the zeros, we first multiply by a matrix with small
*        condition number of the form
*
*        1  0  0  0  0  ...
*           1  +  *  0  0  ...
*              1  +  0  0  0
*                 1  +  *  0  0
*                    1  +  0  0
*                       ...
*                          1  +  0
*                             1  0
*                                1
*
*        Each element marked with a '*' is formed by taking the product
*        of the adjacent elements marked with '+'.  The '*'s can be
*        chosen freely, and the '+'s are chosen so that the inverse of
*        T will have elements of the same magnitude as T.  If the *'s in
*        both T and inv(T) have small magnitude, T is well conditioned.
*        The two offdiagonals of T are stored in WORK.
*
*        The product of these two matrices has the form
*
*        1  y  y  y  y  y  .  y  y  z
*           1  +  *  0  0  .  0  0  y
*              1  +  0  0  .  0  0  y
*                 1  +  *  .  .  .  .
*                    1  +  .  .  .  .
*                       .  .  .  .  .
*                          .  .  .  .
*                             1  +  y
*                                1  y
*                                   1
*
*        Now we multiply by Givens rotations, using the fact that
*
*              [  c   s ] [  1   w ] [ -c  -s ] =  [  1  -w ]
*              [ -s   c ] [  0   1 ] [  s  -c ]    [  0   1 ]
*        and
*              [ -c  -s ] [  1   0 ] [  c   s ] =  [  1   0 ]
*              [  s  -c ] [  w   1 ] [ -s   c ]    [ -w   1 ]
*
*        where c = w / sqrt(w**2+4) and s = 2 / sqrt(w**2+4).
*
         star1 = 0.25*clarnd( 5, iseed )
         sfac = 0.5
         plus1 = sfac*clarnd( 5, iseed )
         DO 90 j = 1, n, 2
            plus2 = star1 / plus1
            work( j ) = plus1
            work( n+j ) = star1
            IF( j+1.LE.n ) THEN
               work( j+1 ) = plus2
               work( n+j+1 ) = zero
               plus1 = star1 / plus2
               rexp = slarnd( 2, iseed )
               IF( rexp.LT.zero ) THEN
                  star1 = -sfac**( one-rexp )*clarnd( 5, iseed )
               ELSE
                  star1 = sfac**( one+rexp )*clarnd( 5, iseed )
               END IF
            END IF
   90    CONTINUE
*
         x = sqrt( cndnum ) - 1 / sqrt( cndnum )
         IF( n.GT.2 ) THEN
            y = sqrt( 2. / ( n-2 ) )*x
         ELSE
            y = zero
         END IF
         z = x*x
*
         IF( upper ) THEN
            IF( n.GT.3 ) THEN
               CALL ccopy( n-3, work, 1, a( 2, 3 ), lda+1 )
               IF( n.GT.4 )
     $            CALL ccopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
            END IF
            DO 100 j = 2, n - 1
               a( 1, j ) = y
               a( j, n ) = y
  100       CONTINUE
            a( 1, n ) = z
         ELSE
            IF( n.GT.3 ) THEN
               CALL ccopy( n-3, work, 1, a( 3, 2 ), lda+1 )
               IF( n.GT.4 )
     $            CALL ccopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
            END IF
            DO 110 j = 2, n - 1
               a( j, 1 ) = y
               a( n, j ) = y
  110       CONTINUE
            a( n, 1 ) = z
         END IF
*
*        Fill in the zeros using Givens rotations.
*
         IF( upper ) THEN
            DO 120 j = 1, n - 1
               ra = a( j, j+1 )
               rb = 2.0
               CALL crotg( ra, rb, c, s )
*
*              Multiply by [ c  s; -conjg(s)  c] on the left.
*
               IF( n.GT.j+1 )
     $            CALL crot( n-j-1, a( j, j+2 ), lda, a( j+1, j+2 ),
     $                       lda, c, s )
*
*              Multiply by [-c -s;  conjg(s) -c] on the right.
*
               IF( j.GT.1 )
     $            CALL crot( j-1, a( 1, j+1 ), 1, a( 1, j ), 1, -c, -s )
*
*              Negate A(J,J+1).
*
               a( j, j+1 ) = -a( j, j+1 )
  120       CONTINUE
         ELSE
            DO 130 j = 1, n - 1
               ra = a( j+1, j )
               rb = 2.0
               CALL crotg( ra, rb, c, s )
               s = conjg( s )
*
*              Multiply by [ c -s;  conjg(s) c] on the right.
*
               IF( n.GT.j+1 )
     $            CALL crot( n-j-1, a( j+2, j+1 ), 1, a( j+2, j ), 1, c,
     $                       -s )
*
*              Multiply by [-c  s; -conjg(s) -c] on the left.
*
               IF( j.GT.1 )
     $            CALL crot( j-1, a( j, 1 ), lda, a( j+1, 1 ), lda, -c,
     $                       s )
*
*              Negate A(J+1,J).
*
               a( j+1, j ) = -a( j+1, j )
  130       CONTINUE
         END IF
*
*     IMAT > 10:  Pathological test cases.  These triangular matrices
*     are badly scaled or badly conditioned, so when used in solving a
*     triangular system they may cause overflow in the solution vector.
*
      ELSE IF( imat.EQ.11 ) THEN
*
*        Type 11:  Generate a triangular matrix with elements between
*        -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
*        Make the right hand side large so that it requires scaling.
*
         IF( upper ) THEN
            DO 140 j = 1, n
               CALL clarnv( 4, iseed, j-1, a( 1, j ) )
               a( j, j ) = clarnd( 5, iseed )*two
  140       CONTINUE
         ELSE
            DO 150 j = 1, n
               IF( j.LT.n )
     $            CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
               a( j, j ) = clarnd( 5, iseed )*two
  150       CONTINUE
         END IF
*
*        Set the right hand side so that the largest value is BIGNUM.
*
         CALL clarnv( 2, iseed, n, b )
         iy = icamax( n, b, 1 )
         bnorm = abs( b( iy ) )
         bscal = bignum / max( one, bnorm )
         CALL csscal( n, bscal, b, 1 )
*
      ELSE IF( imat.EQ.12 ) THEN
*
*        Type 12:  Make the first diagonal element in the solve small to
*        cause immediate overflow when dividing by T(j,j).
*        In type 12, the offdiagonal elements are small (CNORM(j) < 1).
*
         CALL clarnv( 2, iseed, n, b )
         tscal = one / max( one, real( n-1 ) )
         IF( upper ) THEN
            DO 160 j = 1, n
               CALL clarnv( 4, iseed, j-1, a( 1, j ) )
               CALL csscal( j-1, tscal, a( 1, j ), 1 )
               a( j, j ) = clarnd( 5, iseed )
  160       CONTINUE
            a( n, n ) = smlnum*a( n, n )
         ELSE
            DO 170 j = 1, n
               IF( j.LT.n ) THEN
                  CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
                  CALL csscal( n-j, tscal, a( j+1, j ), 1 )
               END IF
               a( j, j ) = clarnd( 5, iseed )
  170       CONTINUE
            a( 1, 1 ) = smlnum*a( 1, 1 )
         END IF
*
      ELSE IF( imat.EQ.13 ) THEN
*
*        Type 13:  Make the first diagonal element in the solve small to
*        cause immediate overflow when dividing by T(j,j).
*        In type 13, the offdiagonal elements are O(1) (CNORM(j) > 1).
*
         CALL clarnv( 2, iseed, n, b )
         IF( upper ) THEN
            DO 180 j = 1, n
               CALL clarnv( 4, iseed, j-1, a( 1, j ) )
               a( j, j ) = clarnd( 5, iseed )
  180       CONTINUE
            a( n, n ) = smlnum*a( n, n )
         ELSE
            DO 190 j = 1, n
               IF( j.LT.n )
     $            CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
               a( j, j ) = clarnd( 5, iseed )
  190       CONTINUE
            a( 1, 1 ) = smlnum*a( 1, 1 )
         END IF
*
      ELSE IF( imat.EQ.14 ) THEN
*
*        Type 14:  T is diagonal with small numbers on the diagonal to
*        make the growth factor underflow, but a small right hand side
*        chosen so that the solution does not overflow.
*
         IF( upper ) THEN
            jcount = 1
            DO 210 j = n, 1, -1
               DO 200 i = 1, j - 1
                  a( i, j ) = zero
  200          CONTINUE
               IF( jcount.LE.2 ) THEN
                  a( j, j ) = smlnum*clarnd( 5, iseed )
               ELSE
                  a( j, j ) = clarnd( 5, iseed )
               END IF
               jcount = jcount + 1
               IF( jcount.GT.4 )
     $            jcount = 1
  210       CONTINUE
         ELSE
            jcount = 1
            DO 230 j = 1, n
               DO 220 i = j + 1, n
                  a( i, j ) = zero
  220          CONTINUE
               IF( jcount.LE.2 ) THEN
                  a( j, j ) = smlnum*clarnd( 5, iseed )
               ELSE
                  a( j, j ) = clarnd( 5, iseed )
               END IF
               jcount = jcount + 1
               IF( jcount.GT.4 )
     $            jcount = 1
  230       CONTINUE
         END IF
*
*        Set the right hand side alternately zero and small.
*
         IF( upper ) THEN
            b( 1 ) = zero
            DO 240 i = n, 2, -2
               b( i ) = zero
               b( i-1 ) = smlnum*clarnd( 5, iseed )
  240       CONTINUE
         ELSE
            b( n ) = zero
            DO 250 i = 1, n - 1, 2
               b( i ) = zero
               b( i+1 ) = smlnum*clarnd( 5, iseed )
  250       CONTINUE
         END IF
*
      ELSE IF( imat.EQ.15 ) THEN
*
*        Type 15:  Make the diagonal elements small to cause gradual
*        overflow when dividing by T(j,j).  To control the amount of
*        scaling needed, the matrix is bidiagonal.
*
         texp = one / max( one, real( n-1 ) )
         tscal = smlnum**texp
         CALL clarnv( 4, iseed, n, b )
         IF( upper ) THEN
            DO 270 j = 1, n
               DO 260 i = 1, j - 2
                  a( i, j ) = 0.
  260          CONTINUE
               IF( j.GT.1 )
     $            a( j-1, j ) = cmplx( -one, -one )
               a( j, j ) = tscal*clarnd( 5, iseed )
  270       CONTINUE
            b( n ) = cmplx( one, one )
         ELSE
            DO 290 j = 1, n
               DO 280 i = j + 2, n
                  a( i, j ) = 0.
  280          CONTINUE
               IF( j.LT.n )
     $            a( j+1, j ) = cmplx( -one, -one )
               a( j, j ) = tscal*clarnd( 5, iseed )
  290       CONTINUE
            b( 1 ) = cmplx( one, one )
         END IF
*
      ELSE IF( imat.EQ.16 ) THEN
*
*        Type 16:  One zero diagonal element.
*
         iy = n / 2 + 1
         IF( upper ) THEN
            DO 300 j = 1, n
               CALL clarnv( 4, iseed, j-1, a( 1, j ) )
               IF( j.NE.iy ) THEN
                  a( j, j ) = clarnd( 5, iseed )*two
               ELSE
                  a( j, j ) = zero
               END IF
  300       CONTINUE
         ELSE
            DO 310 j = 1, n
               IF( j.LT.n )
     $            CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
               IF( j.NE.iy ) THEN
                  a( j, j ) = clarnd( 5, iseed )*two
               ELSE
                  a( j, j ) = zero
               END IF
  310       CONTINUE
         END IF
         CALL clarnv( 2, iseed, n, b )
         CALL csscal( n, two, b, 1 )
*
      ELSE IF( imat.EQ.17 ) THEN
*
*        Type 17:  Make the offdiagonal elements large to cause overflow
*        when adding a column of T.  In the non-transposed case, the
*        matrix is constructed to cause overflow when adding a column in
*        every other step.
*
         tscal = unfl / ulp
         tscal = ( one-ulp ) / tscal
         DO 330 j = 1, n
            DO 320 i = 1, n
               a( i, j ) = 0.
  320       CONTINUE
  330    CONTINUE
         texp = one
         IF( upper ) THEN
            DO 340 j = n, 2, -2
               a( 1, j ) = -tscal / real( n+1 )
               a( j, j ) = one
               b( j ) = texp*( one-ulp )
               a( 1, j-1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
               a( j-1, j-1 ) = one
               b( j-1 ) = texp*real( n*n+n-1 )
               texp = texp*2.
  340       CONTINUE
            b( 1 ) = ( real( n+1 ) / real( n+2 ) )*tscal
         ELSE
            DO 350 j = 1, n - 1, 2
               a( n, j ) = -tscal / real( n+1 )
               a( j, j ) = one
               b( j ) = texp*( one-ulp )
               a( n, j+1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
               a( j+1, j+1 ) = one
               b( j+1 ) = texp*real( n*n+n-1 )
               texp = texp*2.
  350       CONTINUE
            b( n ) = ( real( n+1 ) / real( n+2 ) )*tscal
         END IF
*
      ELSE IF( imat.EQ.18 ) THEN
*
*        Type 18:  Generate a unit triangular matrix with elements
*        between -1 and 1, and make the right hand side large so that it
*        requires scaling.
*
         IF( upper ) THEN
            DO 360 j = 1, n
               CALL clarnv( 4, iseed, j-1, a( 1, j ) )
               a( j, j ) = zero
  360       CONTINUE
         ELSE
            DO 370 j = 1, n
               IF( j.LT.n )
     $            CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
               a( j, j ) = zero
  370       CONTINUE
         END IF
*
*        Set the right hand side so that the largest value is BIGNUM.
*
         CALL clarnv( 2, iseed, n, b )
         iy = icamax( n, b, 1 )
         bnorm = abs( b( iy ) )
         bscal = bignum / max( one, bnorm )
         CALL csscal( n, bscal, b, 1 )
*
      ELSE IF( imat.EQ.19 ) THEN
*
*        Type 19:  Generate a triangular matrix with elements between
*        BIGNUM/(n-1) and BIGNUM so that at least one of the column
*        norms will exceed BIGNUM.
*        1/3/91:  CLATRS no longer can handle this case
*
         tleft = bignum / max( one, real( n-1 ) )
         tscal = bignum*( real( n-1 ) / max( one, real( n ) ) )
         IF( upper ) THEN
            DO 390 j = 1, n
               CALL clarnv( 5, iseed, j, a( 1, j ) )
               CALL slarnv( 1, iseed, j, rwork )
               DO 380 i = 1, j
                  a( i, j ) = a( i, j )*( tleft+rwork( i )*tscal )
  380          CONTINUE
  390       CONTINUE
         ELSE
            DO 410 j = 1, n
               CALL clarnv( 5, iseed, n-j+1, a( j, j ) )
               CALL slarnv( 1, iseed, n-j+1, rwork )
               DO 400 i = j, n
                  a( i, j ) = a( i, j )*( tleft+rwork( i-j+1 )*tscal )
  400          CONTINUE
  410       CONTINUE
         END IF
         CALL clarnv( 2, iseed, n, b )
         CALL csscal( n, two, b, 1 )
      END IF
*
*     Flip the matrix if the transpose will be used.
*
      IF( .NOT.lsame( trans, 'N' ) ) THEN
         IF( upper ) THEN
            DO 420 j = 1, n / 2
               CALL cswap( n-2*j+1, a( j, j ), lda, a( j+1, n-j+1 ),
     $                     -1 )
  420       CONTINUE
         ELSE
            DO 430 j = 1, n / 2
               CALL cswap( n-2*j+1, a( j, j ), 1, a( n-j+1, j+1 ),
     $                     -lda )
  430       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of CLATTR
*
      END