LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ dlattr()

 subroutine dlattr ( integer IMAT, character UPLO, character TRANS, character DIAG, integer, dimension( 4 ) ISEED, integer N, double precision, dimension( lda, * ) A, integer LDA, double precision, dimension( * ) B, double precision, dimension( * ) WORK, integer INFO )

DLATTR

Purpose:
``` DLATTR generates a triangular test matrix.
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 (= 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 DLATMS). Modified on exit.``` [in] N ``` N is INTEGER The order of the matrix to be generated.``` [out] A ``` A is DOUBLE PRECISION array, dimension (LDA,N) The triangular matrix A. If UPLO = 'U', the leading n by 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 by n lower triangular part of the array A contains the lower triangular matrix, and the strictly upper triangular part of A is not referenced. If DIAG = 'U', the diagonal elements of A are set so that A(k,k) = k for 1 <= k <= n.``` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N).``` [out] B ``` B is DOUBLE PRECISION array, dimension (N) The right hand side vector, if IMAT > 10.``` [out] WORK ` WORK is DOUBLE PRECISION array, dimension (3*N)` [out] INFO ``` INFO is INTEGER = 0: successful exit < 0: if INFO = -k, the k-th argument had an illegal value```
Date
December 2016

Definition at line 135 of file dlattr.f.

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