LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ clattr()

subroutine clattr ( integer  IMAT,
character  UPLO,
character  TRANS,
character  DIAG,
integer, dimension( 4 )  ISEED,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  B,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  INFO 
)

CLATTR

Purpose:
 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.
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]A
          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.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,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 136 of file clattr.f.

138 *
139 * -- LAPACK test routine --
140 * -- LAPACK is a software package provided by Univ. of Tennessee, --
141 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142 *
143 * .. Scalar Arguments ..
144  CHARACTER DIAG, TRANS, UPLO
145  INTEGER IMAT, INFO, LDA, N
146 * ..
147 * .. Array Arguments ..
148  INTEGER ISEED( 4 )
149  REAL RWORK( * )
150  COMPLEX A( LDA, * ), B( * ), WORK( * )
151 * ..
152 *
153 * =====================================================================
154 *
155 * .. Parameters ..
156  REAL ONE, TWO, ZERO
157  parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
158 * ..
159 * .. Local Scalars ..
160  LOGICAL UPPER
161  CHARACTER DIST, TYPE
162  CHARACTER*3 PATH
163  INTEGER I, IY, J, JCOUNT, KL, KU, MODE
164  REAL ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
165  $ SFAC, SMLNUM, TEXP, TLEFT, TSCAL, ULP, UNFL, X,
166  $ Y, Z
167  COMPLEX PLUS1, PLUS2, RA, RB, S, STAR1
168 * ..
169 * .. External Functions ..
170  LOGICAL LSAME
171  INTEGER ICAMAX
172  REAL SLAMCH, SLARND
173  COMPLEX CLARND
174  EXTERNAL lsame, icamax, slamch, slarnd, clarnd
175 * ..
176 * .. External Subroutines ..
177  EXTERNAL ccopy, clarnv, clatb4, clatms, crot, crotg,
179 * ..
180 * .. Intrinsic Functions ..
181  INTRINSIC abs, cmplx, conjg, max, real, sqrt
182 * ..
183 * .. Executable Statements ..
184 *
185  path( 1: 1 ) = 'Complex precision'
186  path( 2: 3 ) = 'TR'
187  unfl = slamch( 'Safe minimum' )
188  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
189  smlnum = unfl
190  bignum = ( one-ulp ) / smlnum
191  CALL slabad( smlnum, bignum )
192  IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 ) THEN
193  diag = 'U'
194  ELSE
195  diag = 'N'
196  END IF
197  info = 0
198 *
199 * Quick return if N.LE.0.
200 *
201  IF( n.LE.0 )
202  $ RETURN
203 *
204 * Call CLATB4 to set parameters for CLATMS.
205 *
206  upper = lsame( uplo, 'U' )
207  IF( upper ) THEN
208  CALL clatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
209  $ CNDNUM, DIST )
210  ELSE
211  CALL clatb4( path, -imat, n, n, TYPE, KL, KU, ANORM, MODE,
212  $ CNDNUM, DIST )
213  END IF
214 *
215 * IMAT <= 6: Non-unit triangular matrix
216 *
217  IF( imat.LE.6 ) THEN
218  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE, CNDNUM,
219  $ ANORM, KL, KU, 'No packing', A, LDA, WORK, INFO )
220 *
221 * IMAT > 6: Unit triangular matrix
222 * The diagonal is deliberately set to something other than 1.
223 *
224 * IMAT = 7: Matrix is the identity
225 *
226  ELSE IF( imat.EQ.7 ) THEN
227  IF( upper ) THEN
228  DO 20 j = 1, n
229  DO 10 i = 1, j - 1
230  a( i, j ) = zero
231  10 CONTINUE
232  a( j, j ) = j
233  20 CONTINUE
234  ELSE
235  DO 40 j = 1, n
236  a( j, j ) = j
237  DO 30 i = j + 1, n
238  a( i, j ) = zero
239  30 CONTINUE
240  40 CONTINUE
241  END IF
242 *
243 * IMAT > 7: Non-trivial unit triangular matrix
244 *
245 * Generate a unit triangular matrix T with condition CNDNUM by
246 * forming a triangular matrix with known singular values and
247 * filling in the zero entries with Givens rotations.
248 *
249  ELSE IF( imat.LE.10 ) THEN
250  IF( upper ) THEN
251  DO 60 j = 1, n
252  DO 50 i = 1, j - 1
253  a( i, j ) = zero
254  50 CONTINUE
255  a( j, j ) = j
256  60 CONTINUE
257  ELSE
258  DO 80 j = 1, n
259  a( j, j ) = j
260  DO 70 i = j + 1, n
261  a( i, j ) = zero
262  70 CONTINUE
263  80 CONTINUE
264  END IF
265 *
266 * Since the trace of a unit triangular matrix is 1, the product
267 * of its singular values must be 1. Let s = sqrt(CNDNUM),
268 * x = sqrt(s) - 1/sqrt(s), y = sqrt(2/(n-2))*x, and z = x**2.
269 * The following triangular matrix has singular values s, 1, 1,
270 * ..., 1, 1/s:
271 *
272 * 1 y y y ... y y z
273 * 1 0 0 ... 0 0 y
274 * 1 0 ... 0 0 y
275 * . ... . . .
276 * . . . .
277 * 1 0 y
278 * 1 y
279 * 1
280 *
281 * To fill in the zeros, we first multiply by a matrix with small
282 * condition number of the form
283 *
284 * 1 0 0 0 0 ...
285 * 1 + * 0 0 ...
286 * 1 + 0 0 0
287 * 1 + * 0 0
288 * 1 + 0 0
289 * ...
290 * 1 + 0
291 * 1 0
292 * 1
293 *
294 * Each element marked with a '*' is formed by taking the product
295 * of the adjacent elements marked with '+'. The '*'s can be
296 * chosen freely, and the '+'s are chosen so that the inverse of
297 * T will have elements of the same magnitude as T. If the *'s in
298 * both T and inv(T) have small magnitude, T is well conditioned.
299 * The two offdiagonals of T are stored in WORK.
300 *
301 * The product of these two matrices has the form
302 *
303 * 1 y y y y y . y y z
304 * 1 + * 0 0 . 0 0 y
305 * 1 + 0 0 . 0 0 y
306 * 1 + * . . . .
307 * 1 + . . . .
308 * . . . . .
309 * . . . .
310 * 1 + y
311 * 1 y
312 * 1
313 *
314 * Now we multiply by Givens rotations, using the fact that
315 *
316 * [ c s ] [ 1 w ] [ -c -s ] = [ 1 -w ]
317 * [ -s c ] [ 0 1 ] [ s -c ] [ 0 1 ]
318 * and
319 * [ -c -s ] [ 1 0 ] [ c s ] = [ 1 0 ]
320 * [ s -c ] [ w 1 ] [ -s c ] [ -w 1 ]
321 *
322 * where c = w / sqrt(w**2+4) and s = 2 / sqrt(w**2+4).
323 *
324  star1 = 0.25*clarnd( 5, iseed )
325  sfac = 0.5
326  plus1 = sfac*clarnd( 5, iseed )
327  DO 90 j = 1, n, 2
328  plus2 = star1 / plus1
329  work( j ) = plus1
330  work( n+j ) = star1
331  IF( j+1.LE.n ) THEN
332  work( j+1 ) = plus2
333  work( n+j+1 ) = zero
334  plus1 = star1 / plus2
335  rexp = slarnd( 2, iseed )
336  IF( rexp.LT.zero ) THEN
337  star1 = -sfac**( one-rexp )*clarnd( 5, iseed )
338  ELSE
339  star1 = sfac**( one+rexp )*clarnd( 5, iseed )
340  END IF
341  END IF
342  90 CONTINUE
343 *
344  x = sqrt( cndnum ) - 1 / sqrt( cndnum )
345  IF( n.GT.2 ) THEN
346  y = sqrt( 2. / ( n-2 ) )*x
347  ELSE
348  y = zero
349  END IF
350  z = x*x
351 *
352  IF( upper ) THEN
353  IF( n.GT.3 ) THEN
354  CALL ccopy( n-3, work, 1, a( 2, 3 ), lda+1 )
355  IF( n.GT.4 )
356  $ CALL ccopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
357  END IF
358  DO 100 j = 2, n - 1
359  a( 1, j ) = y
360  a( j, n ) = y
361  100 CONTINUE
362  a( 1, n ) = z
363  ELSE
364  IF( n.GT.3 ) THEN
365  CALL ccopy( n-3, work, 1, a( 3, 2 ), lda+1 )
366  IF( n.GT.4 )
367  $ CALL ccopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
368  END IF
369  DO 110 j = 2, n - 1
370  a( j, 1 ) = y
371  a( n, j ) = y
372  110 CONTINUE
373  a( n, 1 ) = z
374  END IF
375 *
376 * Fill in the zeros using Givens rotations.
377 *
378  IF( upper ) THEN
379  DO 120 j = 1, n - 1
380  ra = a( j, j+1 )
381  rb = 2.0
382  CALL crotg( ra, rb, c, s )
383 *
384 * Multiply by [ c s; -conjg(s) c] on the left.
385 *
386  IF( n.GT.j+1 )
387  $ CALL crot( n-j-1, a( j, j+2 ), lda, a( j+1, j+2 ),
388  $ lda, c, s )
389 *
390 * Multiply by [-c -s; conjg(s) -c] on the right.
391 *
392  IF( j.GT.1 )
393  $ CALL crot( j-1, a( 1, j+1 ), 1, a( 1, j ), 1, -c, -s )
394 *
395 * Negate A(J,J+1).
396 *
397  a( j, j+1 ) = -a( j, j+1 )
398  120 CONTINUE
399  ELSE
400  DO 130 j = 1, n - 1
401  ra = a( j+1, j )
402  rb = 2.0
403  CALL crotg( ra, rb, c, s )
404  s = conjg( s )
405 *
406 * Multiply by [ c -s; conjg(s) c] on the right.
407 *
408  IF( n.GT.j+1 )
409  $ CALL crot( n-j-1, a( j+2, j+1 ), 1, a( j+2, j ), 1, c,
410  $ -s )
411 *
412 * Multiply by [-c s; -conjg(s) -c] on the left.
413 *
414  IF( j.GT.1 )
415  $ CALL crot( j-1, a( j, 1 ), lda, a( j+1, 1 ), lda, -c,
416  $ s )
417 *
418 * Negate A(J+1,J).
419 *
420  a( j+1, j ) = -a( j+1, j )
421  130 CONTINUE
422  END IF
423 *
424 * IMAT > 10: Pathological test cases. These triangular matrices
425 * are badly scaled or badly conditioned, so when used in solving a
426 * triangular system they may cause overflow in the solution vector.
427 *
428  ELSE IF( imat.EQ.11 ) THEN
429 *
430 * Type 11: Generate a triangular matrix with elements between
431 * -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
432 * Make the right hand side large so that it requires scaling.
433 *
434  IF( upper ) THEN
435  DO 140 j = 1, n
436  CALL clarnv( 4, iseed, j-1, a( 1, j ) )
437  a( j, j ) = clarnd( 5, iseed )*two
438  140 CONTINUE
439  ELSE
440  DO 150 j = 1, n
441  IF( j.LT.n )
442  $ CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
443  a( j, j ) = clarnd( 5, iseed )*two
444  150 CONTINUE
445  END IF
446 *
447 * Set the right hand side so that the largest value is BIGNUM.
448 *
449  CALL clarnv( 2, iseed, n, b )
450  iy = icamax( n, b, 1 )
451  bnorm = abs( b( iy ) )
452  bscal = bignum / max( one, bnorm )
453  CALL csscal( n, bscal, b, 1 )
454 *
455  ELSE IF( imat.EQ.12 ) THEN
456 *
457 * Type 12: Make the first diagonal element in the solve small to
458 * cause immediate overflow when dividing by T(j,j).
459 * In type 12, the offdiagonal elements are small (CNORM(j) < 1).
460 *
461  CALL clarnv( 2, iseed, n, b )
462  tscal = one / max( one, real( n-1 ) )
463  IF( upper ) THEN
464  DO 160 j = 1, n
465  CALL clarnv( 4, iseed, j-1, a( 1, j ) )
466  CALL csscal( j-1, tscal, a( 1, j ), 1 )
467  a( j, j ) = clarnd( 5, iseed )
468  160 CONTINUE
469  a( n, n ) = smlnum*a( n, n )
470  ELSE
471  DO 170 j = 1, n
472  IF( j.LT.n ) THEN
473  CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
474  CALL csscal( n-j, tscal, a( j+1, j ), 1 )
475  END IF
476  a( j, j ) = clarnd( 5, iseed )
477  170 CONTINUE
478  a( 1, 1 ) = smlnum*a( 1, 1 )
479  END IF
480 *
481  ELSE IF( imat.EQ.13 ) THEN
482 *
483 * Type 13: Make the first diagonal element in the solve small to
484 * cause immediate overflow when dividing by T(j,j).
485 * In type 13, the offdiagonal elements are O(1) (CNORM(j) > 1).
486 *
487  CALL clarnv( 2, iseed, n, b )
488  IF( upper ) THEN
489  DO 180 j = 1, n
490  CALL clarnv( 4, iseed, j-1, a( 1, j ) )
491  a( j, j ) = clarnd( 5, iseed )
492  180 CONTINUE
493  a( n, n ) = smlnum*a( n, n )
494  ELSE
495  DO 190 j = 1, n
496  IF( j.LT.n )
497  $ CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
498  a( j, j ) = clarnd( 5, iseed )
499  190 CONTINUE
500  a( 1, 1 ) = smlnum*a( 1, 1 )
501  END IF
502 *
503  ELSE IF( imat.EQ.14 ) THEN
504 *
505 * Type 14: T is diagonal with small numbers on the diagonal to
506 * make the growth factor underflow, but a small right hand side
507 * chosen so that the solution does not overflow.
508 *
509  IF( upper ) THEN
510  jcount = 1
511  DO 210 j = n, 1, -1
512  DO 200 i = 1, j - 1
513  a( i, j ) = zero
514  200 CONTINUE
515  IF( jcount.LE.2 ) THEN
516  a( j, j ) = smlnum*clarnd( 5, iseed )
517  ELSE
518  a( j, j ) = clarnd( 5, iseed )
519  END IF
520  jcount = jcount + 1
521  IF( jcount.GT.4 )
522  $ jcount = 1
523  210 CONTINUE
524  ELSE
525  jcount = 1
526  DO 230 j = 1, n
527  DO 220 i = j + 1, n
528  a( i, j ) = zero
529  220 CONTINUE
530  IF( jcount.LE.2 ) THEN
531  a( j, j ) = smlnum*clarnd( 5, iseed )
532  ELSE
533  a( j, j ) = clarnd( 5, iseed )
534  END IF
535  jcount = jcount + 1
536  IF( jcount.GT.4 )
537  $ jcount = 1
538  230 CONTINUE
539  END IF
540 *
541 * Set the right hand side alternately zero and small.
542 *
543  IF( upper ) THEN
544  b( 1 ) = zero
545  DO 240 i = n, 2, -2
546  b( i ) = zero
547  b( i-1 ) = smlnum*clarnd( 5, iseed )
548  240 CONTINUE
549  ELSE
550  b( n ) = zero
551  DO 250 i = 1, n - 1, 2
552  b( i ) = zero
553  b( i+1 ) = smlnum*clarnd( 5, iseed )
554  250 CONTINUE
555  END IF
556 *
557  ELSE IF( imat.EQ.15 ) THEN
558 *
559 * Type 15: Make the diagonal elements small to cause gradual
560 * overflow when dividing by T(j,j). To control the amount of
561 * scaling needed, the matrix is bidiagonal.
562 *
563  texp = one / max( one, real( n-1 ) )
564  tscal = smlnum**texp
565  CALL clarnv( 4, iseed, n, b )
566  IF( upper ) THEN
567  DO 270 j = 1, n
568  DO 260 i = 1, j - 2
569  a( i, j ) = 0.
570  260 CONTINUE
571  IF( j.GT.1 )
572  $ a( j-1, j ) = cmplx( -one, -one )
573  a( j, j ) = tscal*clarnd( 5, iseed )
574  270 CONTINUE
575  b( n ) = cmplx( one, one )
576  ELSE
577  DO 290 j = 1, n
578  DO 280 i = j + 2, n
579  a( i, j ) = 0.
580  280 CONTINUE
581  IF( j.LT.n )
582  $ a( j+1, j ) = cmplx( -one, -one )
583  a( j, j ) = tscal*clarnd( 5, iseed )
584  290 CONTINUE
585  b( 1 ) = cmplx( one, one )
586  END IF
587 *
588  ELSE IF( imat.EQ.16 ) THEN
589 *
590 * Type 16: One zero diagonal element.
591 *
592  iy = n / 2 + 1
593  IF( upper ) THEN
594  DO 300 j = 1, n
595  CALL clarnv( 4, iseed, j-1, a( 1, j ) )
596  IF( j.NE.iy ) THEN
597  a( j, j ) = clarnd( 5, iseed )*two
598  ELSE
599  a( j, j ) = zero
600  END IF
601  300 CONTINUE
602  ELSE
603  DO 310 j = 1, n
604  IF( j.LT.n )
605  $ CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
606  IF( j.NE.iy ) THEN
607  a( j, j ) = clarnd( 5, iseed )*two
608  ELSE
609  a( j, j ) = zero
610  END IF
611  310 CONTINUE
612  END IF
613  CALL clarnv( 2, iseed, n, b )
614  CALL csscal( n, two, b, 1 )
615 *
616  ELSE IF( imat.EQ.17 ) THEN
617 *
618 * Type 17: Make the offdiagonal elements large to cause overflow
619 * when adding a column of T. In the non-transposed case, the
620 * matrix is constructed to cause overflow when adding a column in
621 * every other step.
622 *
623  tscal = unfl / ulp
624  tscal = ( one-ulp ) / tscal
625  DO 330 j = 1, n
626  DO 320 i = 1, n
627  a( i, j ) = 0.
628  320 CONTINUE
629  330 CONTINUE
630  texp = one
631  IF( upper ) THEN
632  DO 340 j = n, 2, -2
633  a( 1, j ) = -tscal / real( n+1 )
634  a( j, j ) = one
635  b( j ) = texp*( one-ulp )
636  a( 1, j-1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
637  a( j-1, j-1 ) = one
638  b( j-1 ) = texp*real( n*n+n-1 )
639  texp = texp*2.
640  340 CONTINUE
641  b( 1 ) = ( real( n+1 ) / real( n+2 ) )*tscal
642  ELSE
643  DO 350 j = 1, n - 1, 2
644  a( n, j ) = -tscal / real( n+1 )
645  a( j, j ) = one
646  b( j ) = texp*( one-ulp )
647  a( n, j+1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
648  a( j+1, j+1 ) = one
649  b( j+1 ) = texp*real( n*n+n-1 )
650  texp = texp*2.
651  350 CONTINUE
652  b( n ) = ( real( n+1 ) / real( n+2 ) )*tscal
653  END IF
654 *
655  ELSE IF( imat.EQ.18 ) THEN
656 *
657 * Type 18: Generate a unit triangular matrix with elements
658 * between -1 and 1, and make the right hand side large so that it
659 * requires scaling.
660 *
661  IF( upper ) THEN
662  DO 360 j = 1, n
663  CALL clarnv( 4, iseed, j-1, a( 1, j ) )
664  a( j, j ) = zero
665  360 CONTINUE
666  ELSE
667  DO 370 j = 1, n
668  IF( j.LT.n )
669  $ CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
670  a( j, j ) = zero
671  370 CONTINUE
672  END IF
673 *
674 * Set the right hand side so that the largest value is BIGNUM.
675 *
676  CALL clarnv( 2, iseed, n, b )
677  iy = icamax( n, b, 1 )
678  bnorm = abs( b( iy ) )
679  bscal = bignum / max( one, bnorm )
680  CALL csscal( n, bscal, b, 1 )
681 *
682  ELSE IF( imat.EQ.19 ) THEN
683 *
684 * Type 19: Generate a triangular matrix with elements between
685 * BIGNUM/(n-1) and BIGNUM so that at least one of the column
686 * norms will exceed BIGNUM.
687 * 1/3/91: CLATRS no longer can handle this case
688 *
689  tleft = bignum / max( one, real( n-1 ) )
690  tscal = bignum*( real( n-1 ) / max( one, real( n ) ) )
691  IF( upper ) THEN
692  DO 390 j = 1, n
693  CALL clarnv( 5, iseed, j, a( 1, j ) )
694  CALL slarnv( 1, iseed, j, rwork )
695  DO 380 i = 1, j
696  a( i, j ) = a( i, j )*( tleft+rwork( i )*tscal )
697  380 CONTINUE
698  390 CONTINUE
699  ELSE
700  DO 410 j = 1, n
701  CALL clarnv( 5, iseed, n-j+1, a( j, j ) )
702  CALL slarnv( 1, iseed, n-j+1, rwork )
703  DO 400 i = j, n
704  a( i, j ) = a( i, j )*( tleft+rwork( i-j+1 )*tscal )
705  400 CONTINUE
706  410 CONTINUE
707  END IF
708  CALL clarnv( 2, iseed, n, b )
709  CALL csscal( n, two, b, 1 )
710  END IF
711 *
712 * Flip the matrix if the transpose will be used.
713 *
714  IF( .NOT.lsame( trans, 'N' ) ) THEN
715  IF( upper ) THEN
716  DO 420 j = 1, n / 2
717  CALL cswap( n-2*j+1, a( j, j ), lda, a( j+1, n-j+1 ),
718  $ -1 )
719  420 CONTINUE
720  ELSE
721  DO 430 j = 1, n / 2
722  CALL cswap( n-2*j+1, a( j, j ), 1, a( n-j+1, j+1 ),
723  $ -lda )
724  430 CONTINUE
725  END IF
726  END IF
727 *
728  RETURN
729 *
730 * End of CLATTR
731 *
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: slarnv.f:97
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:71
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:81
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:121
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:332
complex function clarnd(IDIST, ISEED)
CLARND
Definition: clarnd.f:75
subroutine crot(N, CX, INCX, CY, INCY, C, S)
CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
Definition: crot.f:103
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: clarnv.f:99
real function slarnd(IDIST, ISEED)
SLARND
Definition: slarnd.f:73
subroutine crotg(a, b, c, s)
CROTG
Definition: crotg.f90:91
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: