![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZLARGE 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZLARGE( N, A, LDA, ISEED, WORK, INFO ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER INFO, LDA, N 00015 * .. 00016 * .. Array Arguments .. 00017 * INTEGER ISEED( 4 ) 00018 * COMPLEX*16 A( LDA, * ), WORK( * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> ZLARGE pre- and post-multiplies a complex general n by n matrix A 00028 *> with a random unitary matrix: A = U*D*U'. 00029 *> \endverbatim 00030 * 00031 * Arguments: 00032 * ========== 00033 * 00034 *> \param[in] N 00035 *> \verbatim 00036 *> N is INTEGER 00037 *> The order of the matrix A. N >= 0. 00038 *> \endverbatim 00039 *> 00040 *> \param[in,out] A 00041 *> \verbatim 00042 *> A is COMPLEX*16 array, dimension (LDA,N) 00043 *> On entry, the original n by n matrix A. 00044 *> On exit, A is overwritten by U*A*U' for some random 00045 *> unitary matrix U. 00046 *> \endverbatim 00047 *> 00048 *> \param[in] LDA 00049 *> \verbatim 00050 *> LDA is INTEGER 00051 *> The leading dimension of the array A. LDA >= N. 00052 *> \endverbatim 00053 *> 00054 *> \param[in,out] ISEED 00055 *> \verbatim 00056 *> ISEED is INTEGER array, dimension (4) 00057 *> On entry, the seed of the random number generator; the array 00058 *> elements must be between 0 and 4095, and ISEED(4) must be 00059 *> odd. 00060 *> On exit, the seed is updated. 00061 *> \endverbatim 00062 *> 00063 *> \param[out] WORK 00064 *> \verbatim 00065 *> WORK is COMPLEX*16 array, dimension (2*N) 00066 *> \endverbatim 00067 *> 00068 *> \param[out] INFO 00069 *> \verbatim 00070 *> INFO is INTEGER 00071 *> = 0: successful exit 00072 *> < 0: if INFO = -i, the i-th argument had an illegal value 00073 *> \endverbatim 00074 * 00075 * Authors: 00076 * ======== 00077 * 00078 *> \author Univ. of Tennessee 00079 *> \author Univ. of California Berkeley 00080 *> \author Univ. of Colorado Denver 00081 *> \author NAG Ltd. 00082 * 00083 *> \date November 2011 00084 * 00085 *> \ingroup complex16_matgen 00086 * 00087 * ===================================================================== 00088 SUBROUTINE ZLARGE( N, A, LDA, ISEED, WORK, INFO ) 00089 * 00090 * -- LAPACK auxiliary routine (version 3.4.0) -- 00091 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00092 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00093 * November 2011 00094 * 00095 * .. Scalar Arguments .. 00096 INTEGER INFO, LDA, N 00097 * .. 00098 * .. Array Arguments .. 00099 INTEGER ISEED( 4 ) 00100 COMPLEX*16 A( LDA, * ), WORK( * ) 00101 * .. 00102 * 00103 * ===================================================================== 00104 * 00105 * .. Parameters .. 00106 COMPLEX*16 ZERO, ONE 00107 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), 00108 $ ONE = ( 1.0D+0, 0.0D+0 ) ) 00109 * .. 00110 * .. Local Scalars .. 00111 INTEGER I 00112 DOUBLE PRECISION WN 00113 COMPLEX*16 TAU, WA, WB 00114 * .. 00115 * .. External Subroutines .. 00116 EXTERNAL XERBLA, ZGEMV, ZGERC, ZLARNV, ZSCAL 00117 * .. 00118 * .. Intrinsic Functions .. 00119 INTRINSIC ABS, DBLE, MAX 00120 * .. 00121 * .. External Functions .. 00122 DOUBLE PRECISION DZNRM2 00123 EXTERNAL DZNRM2 00124 * .. 00125 * .. Executable Statements .. 00126 * 00127 * Test the input arguments 00128 * 00129 INFO = 0 00130 IF( N.LT.0 ) THEN 00131 INFO = -1 00132 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00133 INFO = -3 00134 END IF 00135 IF( INFO.LT.0 ) THEN 00136 CALL XERBLA( 'ZLARGE', -INFO ) 00137 RETURN 00138 END IF 00139 * 00140 * pre- and post-multiply A by random unitary matrix 00141 * 00142 DO 10 I = N, 1, -1 00143 * 00144 * generate random reflection 00145 * 00146 CALL ZLARNV( 3, ISEED, N-I+1, WORK ) 00147 WN = DZNRM2( N-I+1, WORK, 1 ) 00148 WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) 00149 IF( WN.EQ.ZERO ) THEN 00150 TAU = ZERO 00151 ELSE 00152 WB = WORK( 1 ) + WA 00153 CALL ZSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) 00154 WORK( 1 ) = ONE 00155 TAU = DBLE( WB / WA ) 00156 END IF 00157 * 00158 * multiply A(i:n,1:n) by random reflection from the left 00159 * 00160 CALL ZGEMV( 'Conjugate transpose', N-I+1, N, ONE, A( I, 1 ), 00161 $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 ) 00162 CALL ZGERC( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ), 00163 $ LDA ) 00164 * 00165 * multiply A(1:n,i:n) by random reflection from the right 00166 * 00167 CALL ZGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA, 00168 $ WORK, 1, ZERO, WORK( N+1 ), 1 ) 00169 CALL ZGERC( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ), 00170 $ LDA ) 00171 10 CONTINUE 00172 RETURN 00173 * 00174 * End of ZLARGE 00175 * 00176 END