LAPACK 3.3.1
Linear Algebra PACKage

dlarge.f

Go to the documentation of this file.
00001       SUBROUTINE DLARGE( N, A, LDA, ISEED, WORK, INFO )
00002 *
00003 *  -- LAPACK auxiliary test routine (version 3.1)
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            INFO, LDA, N
00009 *     ..
00010 *     .. Array Arguments ..
00011       INTEGER            ISEED( 4 )
00012       DOUBLE PRECISION   A( LDA, * ), WORK( * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  DLARGE pre- and post-multiplies a real general n by n matrix A
00019 *  with a random orthogonal matrix: A = U*D*U'.
00020 *
00021 *  Arguments
00022 *  =========
00023 *
00024 *  N       (input) INTEGER
00025 *          The order of the matrix A.  N >= 0.
00026 *
00027 *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
00028 *          On entry, the original n by n matrix A.
00029 *          On exit, A is overwritten by U*A*U' for some random
00030 *          orthogonal matrix U.
00031 *
00032 *  LDA     (input) INTEGER
00033 *          The leading dimension of the array A.  LDA >= N.
00034 *
00035 *  ISEED   (input/output) INTEGER array, dimension (4)
00036 *          On entry, the seed of the random number generator; the array
00037 *          elements must be between 0 and 4095, and ISEED(4) must be
00038 *          odd.
00039 *          On exit, the seed is updated.
00040 *
00041 *  WORK    (workspace) DOUBLE PRECISION array, dimension (2*N)
00042 *
00043 *  INFO    (output) INTEGER
00044 *          = 0: successful exit
00045 *          < 0: if INFO = -i, the i-th argument had an illegal value
00046 *
00047 *  =====================================================================
00048 *
00049 *     .. Parameters ..
00050       DOUBLE PRECISION   ZERO, ONE
00051       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
00052 *     ..
00053 *     .. Local Scalars ..
00054       INTEGER            I
00055       DOUBLE PRECISION   TAU, WA, WB, WN
00056 *     ..
00057 *     .. External Subroutines ..
00058       EXTERNAL           DGEMV, DGER, DLARNV, DSCAL, XERBLA
00059 *     ..
00060 *     .. Intrinsic Functions ..
00061       INTRINSIC          MAX, SIGN
00062 *     ..
00063 *     .. External Functions ..
00064       DOUBLE PRECISION   DNRM2
00065       EXTERNAL           DNRM2
00066 *     ..
00067 *     .. Executable Statements ..
00068 *
00069 *     Test the input arguments
00070 *
00071       INFO = 0
00072       IF( N.LT.0 ) THEN
00073          INFO = -1
00074       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00075          INFO = -3
00076       END IF
00077       IF( INFO.LT.0 ) THEN
00078          CALL XERBLA( 'DLARGE', -INFO )
00079          RETURN
00080       END IF
00081 *
00082 *     pre- and post-multiply A by random orthogonal matrix
00083 *
00084       DO 10 I = N, 1, -1
00085 *
00086 *        generate random reflection
00087 *
00088          CALL DLARNV( 3, ISEED, N-I+1, WORK )
00089          WN = DNRM2( N-I+1, WORK, 1 )
00090          WA = SIGN( WN, WORK( 1 ) )
00091          IF( WN.EQ.ZERO ) THEN
00092             TAU = ZERO
00093          ELSE
00094             WB = WORK( 1 ) + WA
00095             CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
00096             WORK( 1 ) = ONE
00097             TAU = WB / WA
00098          END IF
00099 *
00100 *        multiply A(i:n,1:n) by random reflection from the left
00101 *
00102          CALL DGEMV( 'Transpose', N-I+1, N, ONE, A( I, 1 ), LDA, WORK,
00103      $               1, ZERO, WORK( N+1 ), 1 )
00104          CALL DGER( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
00105      $              LDA )
00106 *
00107 *        multiply A(1:n,i:n) by random reflection from the right
00108 *
00109          CALL DGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
00110      $               WORK, 1, ZERO, WORK( N+1 ), 1 )
00111          CALL DGER( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
00112      $              LDA )
00113    10 CONTINUE
00114       RETURN
00115 *
00116 *     End of DLARGE
00117 *
00118       END
 All Files Functions