clattp()

subroutine clattp	(	integer	imat,
		character	uplo,
		character	trans,
		character	diag,
		integer, dimension( 4 )	iseed,
		integer	n,
		complex, dimension( * )	ap,
		complex, dimension( * )	b,
		complex, dimension( * )	work,
		real, dimension( * )	rwork,
		integer	info )

CLATTP

Purpose:

!>
!> CLATTP generates a triangular test matrix in packed storage.
!> IMAT and UPLO uniquely specify the properties of the test matrix,
!> which is returned in the array AP.
!> 

Parameters

[in]	IMAT	!> IMAT is INTEGER !> An integer key describing which matrix to generate for this !> path. !>
[in]	UPLO	!> UPLO is CHARACTER*1 !> Specifies whether the matrix A will be upper or lower !> triangular. !> = 'U': Upper triangular !> = 'L': Lower triangular !>
[in]	TRANS	!> TRANS is CHARACTER*1 !> Specifies whether the matrix or its transpose will be used. !> = 'N': No transpose !> = 'T': Transpose !> = 'C': Conjugate transpose !>
[out]	DIAG	!> DIAG is CHARACTER*1 !> Specifies whether or not the matrix A is unit triangular. !> = 'N': Non-unit triangular !> = 'U': Unit triangular !>
[in,out]	ISEED	!> ISEED is INTEGER array, dimension (4) !> The seed vector for the random number generator (used in !> CLATMS). Modified on exit. !>
[in]	N	!> N is INTEGER !> The order of the matrix to be generated. !>
[out]	AP	!> AP is COMPLEX array, dimension (N*(N+1)/2) !> The upper or lower triangular matrix A, packed columnwise in !> a linear array. The j-th column of A is stored in the array !> AP as follows: !> if UPLO = 'U', AP((j-1)*j/2 + i) = A(i,j) for 1<=i<=j; !> if UPLO = 'L', !> AP((j-1)*(n-j) + j*(j+1)/2 + i-j) = A(i,j) for j<=i<=n. !>
[out]	B	!> B is COMPLEX array, dimension (N) !> The right hand side vector, if IMAT > 10. !>
[out]	WORK	!> WORK is COMPLEX array, dimension (2*N) !>
[out]	RWORK	!> RWORK is REAL array, dimension (N) !>
[out]	INFO	!> INFO is INTEGER !> = 0: successful exit !> < 0: if INFO = -i, the i-th argument had an illegal value !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 129 of file clattp.f.

*
*  -- 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, N
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 )
      REAL               RWORK( * )
      COMPLEX            AP( * ), 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, PACKIT, TYPE
      CHARACTER*3        PATH
      INTEGER            I, IY, J, JC, JCNEXT, JCOUNT, JJ, JL, JR, JX,
     $                   KL, KU, MODE
      REAL               ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
     $                   SFAC, SMLNUM, T, TEXP, TLEFT, TSCAL, ULP, UNFL,
     $                   X, Y, Z
      COMPLEX            CTEMP, PLUS1, PLUS2, RA, RB, S, STAR1
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICAMAX
      REAL               SLAMCH
      COMPLEX            CLARND
      EXTERNAL           lsame, icamax, slamch, clarnd
*     ..
*     .. External Subroutines ..
      EXTERNAL           clarnv, clatb4, clatms, crot, crotg, csscal,
     $                   slarnv
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, cmplx, conjg, max, real, sqrt
*     ..
*     .. Executable Statements ..
*
      path( 1: 1 ) = 'Complex precision'
      path( 2: 3 ) = 'TP'
      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 )
         packit = 'C'
      ELSE
         CALL clatb4( path, -imat, n, n, TYPE, KL, KU, ANORM, MODE,
     $                CNDNUM, DIST )
         packit = 'R'
      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, PACKIT, AP, N, 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
            jc = 1
            DO 20 j = 1, n
               DO 10 i = 1, j - 1
                  ap( jc+i-1 ) = zero
   10          CONTINUE
               ap( jc+j-1 ) = j
               jc = jc + j
   20       CONTINUE
         ELSE
            jc = 1
            DO 40 j = 1, n
               ap( jc ) = j
               DO 30 i = j + 1, n
                  ap( jc+i-j ) = zero
   30          CONTINUE
               jc = jc + n - j + 1
   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
            jc = 0
            DO 60 j = 1, n
               DO 50 i = 1, j - 1
                  ap( jc+i ) = zero
   50          CONTINUE
               ap( jc+j ) = j
               jc = jc + j
   60       CONTINUE
         ELSE
            jc = 1
            DO 80 j = 1, n
               ap( jc ) = j
               DO 70 i = j + 1, n
                  ap( jc+i-j ) = zero
   70          CONTINUE
               jc = jc + n - j + 1
   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 = real( clarnd( 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 ) - one / sqrt( cndnum )
         IF( n.GT.2 ) THEN
            y = sqrt( two / real( n-2 ) )*x
         ELSE
            y = zero
         END IF
         z = x*x
*
         IF( upper ) THEN
*
*           Set the upper triangle of A with a unit triangular matrix
*           of known condition number.
*
            jc = 1
            DO 100 j = 2, n
               ap( jc+1 ) = y
               IF( j.GT.2 )
     $            ap( jc+j-1 ) = work( j-2 )
               IF( j.GT.3 )
     $            ap( jc+j-2 ) = work( n+j-3 )
               jc = jc + j
  100       CONTINUE
            jc = jc - n
            ap( jc+1 ) = z
            DO 110 j = 2, n - 1
               ap( jc+j ) = y
  110       CONTINUE
         ELSE
*
*           Set the lower triangle of A with a unit triangular matrix
*           of known condition number.
*
            DO 120 i = 2, n - 1
               ap( i ) = y
  120       CONTINUE
            ap( n ) = z
            jc = n + 1
            DO 130 j = 2, n - 1
               ap( jc+1 ) = work( j-1 )
               IF( j.LT.n-1 )
     $            ap( jc+2 ) = work( n+j-1 )
               ap( jc+n-j ) = y
               jc = jc + n - j + 1
  130       CONTINUE
         END IF
*
*        Fill in the zeros using Givens rotations
*
         IF( upper ) THEN
            jc = 1
            DO 150 j = 1, n - 1
               jcnext = jc + j
               ra = ap( jcnext+j-1 )
               rb = two
               CALL crotg( ra, rb, c, s )
*
*              Multiply by [ c  s; -conjg(s)  c] on the left.
*
               IF( n.GT.j+1 ) THEN
                  jx = jcnext + j
                  DO 140 i = j + 2, n
                     ctemp = c*ap( jx+j ) + s*ap( jx+j+1 )
                     ap( jx+j+1 ) = -conjg( s )*ap( jx+j ) +
     $                              c*ap( jx+j+1 )
                     ap( jx+j ) = ctemp
                     jx = jx + i
  140             CONTINUE
               END IF
*
*              Multiply by [-c -s;  conjg(s) -c] on the right.
*
               IF( j.GT.1 )
     $            CALL crot( j-1, ap( jcnext ), 1, ap( jc ), 1, -c, -s )
*
*              Negate A(J,J+1).
*
               ap( jcnext+j-1 ) = -ap( jcnext+j-1 )
               jc = jcnext
  150       CONTINUE
         ELSE
            jc = 1
            DO 170 j = 1, n - 1
               jcnext = jc + n - j + 1
               ra = ap( jc+1 )
               rb = two
               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, ap( jcnext+1 ), 1, ap( jc+2 ), 1, c,
     $                       -s )
*
*              Multiply by [-c  s; -conjg(s) -c] on the left.
*
               IF( j.GT.1 ) THEN
                  jx = 1
                  DO 160 i = 1, j - 1
                     ctemp = -c*ap( jx+j-i ) + s*ap( jx+j-i+1 )
                     ap( jx+j-i+1 ) = -conjg( s )*ap( jx+j-i ) -
     $                                c*ap( jx+j-i+1 )
                     ap( jx+j-i ) = ctemp
                     jx = jx + n - i + 1
  160             CONTINUE
               END IF
*
*              Negate A(J+1,J).
*
               ap( jc+1 ) = -ap( jc+1 )
               jc = jcnext
  170       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
            jc = 1
            DO 180 j = 1, n
               CALL clarnv( 4, iseed, j-1, ap( jc ) )
               ap( jc+j-1 ) = clarnd( 5, iseed )*two
               jc = jc + j
  180       CONTINUE
         ELSE
            jc = 1
            DO 190 j = 1, n
               IF( j.LT.n )
     $            CALL clarnv( 4, iseed, n-j, ap( jc+1 ) )
               ap( jc ) = clarnd( 5, iseed )*two
               jc = jc + n - j + 1
  190       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
            jc = 1
            DO 200 j = 1, n
               CALL clarnv( 4, iseed, j-1, ap( jc ) )
               CALL csscal( j-1, tscal, ap( jc ), 1 )
               ap( jc+j-1 ) = clarnd( 5, iseed )
               jc = jc + j
  200       CONTINUE
            ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
         ELSE
            jc = 1
            DO 210 j = 1, n
               CALL clarnv( 2, iseed, n-j, ap( jc+1 ) )
               CALL csscal( n-j, tscal, ap( jc+1 ), 1 )
               ap( jc ) = clarnd( 5, iseed )
               jc = jc + n - j + 1
  210       CONTINUE
            ap( 1 ) = smlnum*ap( 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
            jc = 1
            DO 220 j = 1, n
               CALL clarnv( 4, iseed, j-1, ap( jc ) )
               ap( jc+j-1 ) = clarnd( 5, iseed )
               jc = jc + j
  220       CONTINUE
            ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
         ELSE
            jc = 1
            DO 230 j = 1, n
               CALL clarnv( 4, iseed, n-j, ap( jc+1 ) )
               ap( jc ) = clarnd( 5, iseed )
               jc = jc + n - j + 1
  230       CONTINUE
            ap( 1 ) = smlnum*ap( 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
            jc = ( n-1 )*n / 2 + 1
            DO 250 j = n, 1, -1
               DO 240 i = 1, j - 1
                  ap( jc+i-1 ) = zero
  240          CONTINUE
               IF( jcount.LE.2 ) THEN
                  ap( jc+j-1 ) = smlnum*clarnd( 5, iseed )
               ELSE
                  ap( jc+j-1 ) = clarnd( 5, iseed )
               END IF
               jcount = jcount + 1
               IF( jcount.GT.4 )
     $            jcount = 1
               jc = jc - j + 1
  250       CONTINUE
         ELSE
            jcount = 1
            jc = 1
            DO 270 j = 1, n
               DO 260 i = j + 1, n
                  ap( jc+i-j ) = zero
  260          CONTINUE
               IF( jcount.LE.2 ) THEN
                  ap( jc ) = smlnum*clarnd( 5, iseed )
               ELSE
                  ap( jc ) = clarnd( 5, iseed )
               END IF
               jcount = jcount + 1
               IF( jcount.GT.4 )
     $            jcount = 1
               jc = jc + n - j + 1
  270       CONTINUE
         END IF
*
*        Set the right hand side alternately zero and small.
*
         IF( upper ) THEN
            b( 1 ) = zero
            DO 280 i = n, 2, -2
               b( i ) = zero
               b( i-1 ) = smlnum*clarnd( 5, iseed )
  280       CONTINUE
         ELSE
            b( n ) = zero
            DO 290 i = 1, n - 1, 2
               b( i ) = zero
               b( i+1 ) = smlnum*clarnd( 5, iseed )
  290       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
            jc = 1
            DO 310 j = 1, n
               DO 300 i = 1, j - 2
                  ap( jc+i-1 ) = zero
  300          CONTINUE
               IF( j.GT.1 )
     $            ap( jc+j-2 ) = cmplx( -one, -one )
               ap( jc+j-1 ) = tscal*clarnd( 5, iseed )
               jc = jc + j
  310       CONTINUE
            b( n ) = cmplx( one, one )
         ELSE
            jc = 1
            DO 330 j = 1, n
               DO 320 i = j + 2, n
                  ap( jc+i-j ) = zero
  320          CONTINUE
               IF( j.LT.n )
     $            ap( jc+1 ) = cmplx( -one, -one )
               ap( jc ) = tscal*clarnd( 5, iseed )
               jc = jc + n - j + 1
  330       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
            jc = 1
            DO 340 j = 1, n
               CALL clarnv( 4, iseed, j, ap( jc ) )
               IF( j.NE.iy ) THEN
                  ap( jc+j-1 ) = clarnd( 5, iseed )*two
               ELSE
                  ap( jc+j-1 ) = zero
               END IF
               jc = jc + j
  340       CONTINUE
         ELSE
            jc = 1
            DO 350 j = 1, n
               CALL clarnv( 4, iseed, n-j+1, ap( jc ) )
               IF( j.NE.iy ) THEN
                  ap( jc ) = clarnd( 5, iseed )*two
               ELSE
                  ap( jc ) = zero
               END IF
               jc = jc + n - j + 1
  350       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 360 j = 1, n*( n+1 ) / 2
            ap( j ) = zero
  360    CONTINUE
         texp = one
         IF( upper ) THEN
            jc = ( n-1 )*n / 2 + 1
            DO 370 j = n, 2, -2
               ap( jc ) = -tscal / real( n+1 )
               ap( jc+j-1 ) = one
               b( j ) = texp*( one-ulp )
               jc = jc - j + 1
               ap( jc ) = -( tscal / real( n+1 ) ) / real( n+2 )
               ap( jc+j-2 ) = one
               b( j-1 ) = texp*real( n*n+n-1 )
               texp = texp*two
               jc = jc - j + 2
  370       CONTINUE
            b( 1 ) = ( real( n+1 ) / real( n+2 ) )*tscal
         ELSE
            jc = 1
            DO 380 j = 1, n - 1, 2
               ap( jc+n-j ) = -tscal / real( n+1 )
               ap( jc ) = one
               b( j ) = texp*( one-ulp )
               jc = jc + n - j + 1
               ap( jc+n-j-1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
               ap( jc ) = one
               b( j+1 ) = texp*real( n*n+n-1 )
               texp = texp*two
               jc = jc + n - j
  380       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
            jc = 1
            DO 390 j = 1, n
               CALL clarnv( 4, iseed, j-1, ap( jc ) )
               ap( jc+j-1 ) = zero
               jc = jc + j
  390       CONTINUE
         ELSE
            jc = 1
            DO 400 j = 1, n
               IF( j.LT.n )
     $            CALL clarnv( 4, iseed, n-j, ap( jc+1 ) )
               ap( jc ) = zero
               jc = jc + n - j + 1
  400       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:  CLATPS 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
            jc = 1
            DO 420 j = 1, n
               CALL clarnv( 5, iseed, j, ap( jc ) )
               CALL slarnv( 1, iseed, j, rwork )
               DO 410 i = 1, j
                  ap( jc+i-1 ) = ap( jc+i-1 )*( tleft+rwork( i )*tscal )
  410          CONTINUE
               jc = jc + j
  420       CONTINUE
         ELSE
            jc = 1
            DO 440 j = 1, n
               CALL clarnv( 5, iseed, n-j+1, ap( jc ) )
               CALL slarnv( 1, iseed, n-j+1, rwork )
               DO 430 i = j, n
                  ap( jc+i-j ) = ap( jc+i-j )*
     $                           ( tleft+rwork( i-j+1 )*tscal )
  430          CONTINUE
               jc = jc + n - j + 1
  440       CONTINUE
         END IF
         CALL clarnv( 2, iseed, n, b )
         CALL csscal( n, two, b, 1 )
      END IF
*
*     Flip the matrix across its counter-diagonal if the transpose will
*     be used.
*
      IF( .NOT.lsame( trans, 'N' ) ) THEN
         IF( upper ) THEN
            jj = 1
            jr = n*( n+1 ) / 2
            DO 460 j = 1, n / 2
               jl = jj
               DO 450 i = j, n - j
                  t = real( ap( jr-i+j ) )
                  ap( jr-i+j ) = ap( jl )
                  ap( jl ) = t
                  jl = jl + i
  450          CONTINUE
               jj = jj + j + 1
               jr = jr - ( n-j+1 )
  460       CONTINUE
         ELSE
            jl = 1
            jj = n*( n+1 ) / 2
            DO 480 j = 1, n / 2
               jr = jj
               DO 470 i = j, n - j
                  t = real( ap( jl+i-j ) )
                  ap( jl+i-j ) = ap( jr )
                  ap( jr ) = t
                  jr = jr - i
  470          CONTINUE
               jl = jl + n - j + 1
               jj = jj - j - 1
  480       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of CLATTP
*

Here is the call graph for this function:

Here is the caller graph for this function: