LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine claghe ( integer N, integer K, real, dimension( * ) D, complex, dimension( lda, * ) A, integer LDA, integer, dimension( 4 ) ISEED, complex, dimension( * ) WORK, integer INFO )

CLAGHE

Purpose:
``` CLAGHE generates a complex hermitian matrix A, by pre- and post-
multiplying a real diagonal matrix D with a random unitary matrix:
A = U*D*U'. The semi-bandwidth may then be reduced to k by additional
unitary transformations.```
Parameters
 [in] N ``` N is INTEGER The order of the matrix A. N >= 0.``` [in] K ``` K is INTEGER The number of nonzero subdiagonals within the band of A. 0 <= K <= N-1.``` [in] D ``` D is REAL array, dimension (N) The diagonal elements of the diagonal matrix D.``` [out] A ``` A is COMPLEX array, dimension (LDA,N) The generated n by n hermitian matrix A (the full matrix is stored).``` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= N.``` [in,out] ISEED ``` ISEED is INTEGER array, dimension (4) On entry, the seed of the random number generator; the array elements must be between 0 and 4095, and ISEED(4) must be odd. On exit, the seed is updated.``` [out] WORK ` WORK is COMPLEX array, dimension (2*N)` [out] INFO ``` INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value```
Date
November 2011

Definition at line 104 of file claghe.f.

104 *
105 * -- LAPACK auxiliary routine (version 3.4.0) --
106 * -- LAPACK is a software package provided by Univ. of Tennessee, --
107 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108 * November 2011
109 *
110 * .. Scalar Arguments ..
111  INTEGER info, k, lda, n
112 * ..
113 * .. Array Arguments ..
114  INTEGER iseed( 4 )
115  REAL d( * )
116  COMPLEX a( lda, * ), work( * )
117 * ..
118 *
119 * =====================================================================
120 *
121 * .. Parameters ..
122  COMPLEX zero, one, half
123  parameter ( zero = ( 0.0e+0, 0.0e+0 ),
124  \$ one = ( 1.0e+0, 0.0e+0 ),
125  \$ half = ( 0.5e+0, 0.0e+0 ) )
126 * ..
127 * .. Local Scalars ..
128  INTEGER i, j
129  REAL wn
130  COMPLEX alpha, tau, wa, wb
131 * ..
132 * .. External Subroutines ..
133  EXTERNAL caxpy, cgemv, cgerc, chemv, cher2, clarnv,
134  \$ cscal, xerbla
135 * ..
136 * .. External Functions ..
137  REAL scnrm2
138  COMPLEX cdotc
139  EXTERNAL scnrm2, cdotc
140 * ..
141 * .. Intrinsic Functions ..
142  INTRINSIC abs, conjg, max, real
143 * ..
144 * .. Executable Statements ..
145 *
146 * Test the input arguments
147 *
148  info = 0
149  IF( n.LT.0 ) THEN
150  info = -1
151  ELSE IF( k.LT.0 .OR. k.GT.n-1 ) THEN
152  info = -2
153  ELSE IF( lda.LT.max( 1, n ) ) THEN
154  info = -5
155  END IF
156  IF( info.LT.0 ) THEN
157  CALL xerbla( 'CLAGHE', -info )
158  RETURN
159  END IF
160 *
161 * initialize lower triangle of A to diagonal matrix
162 *
163  DO 20 j = 1, n
164  DO 10 i = j + 1, n
165  a( i, j ) = zero
166  10 CONTINUE
167  20 CONTINUE
168  DO 30 i = 1, n
169  a( i, i ) = d( i )
170  30 CONTINUE
171 *
172 * Generate lower triangle of hermitian matrix
173 *
174  DO 40 i = n - 1, 1, -1
175 *
176 * generate random reflection
177 *
178  CALL clarnv( 3, iseed, n-i+1, work )
179  wn = scnrm2( n-i+1, work, 1 )
180  wa = ( wn / abs( work( 1 ) ) )*work( 1 )
181  IF( wn.EQ.zero ) THEN
182  tau = zero
183  ELSE
184  wb = work( 1 ) + wa
185  CALL cscal( n-i, one / wb, work( 2 ), 1 )
186  work( 1 ) = one
187  tau = REAL( wb / wa )
188  END IF
189 *
190 * apply random reflection to A(i:n,i:n) from the left
191 * and the right
192 *
193 * compute y := tau * A * u
194 *
195  CALL chemv( 'Lower', n-i+1, tau, a( i, i ), lda, work, 1, zero,
196  \$ work( n+1 ), 1 )
197 *
198 * compute v := y - 1/2 * tau * ( y, u ) * u
199 *
200  alpha = -half*tau*cdotc( n-i+1, work( n+1 ), 1, work, 1 )
201  CALL caxpy( n-i+1, alpha, work, 1, work( n+1 ), 1 )
202 *
203 * apply the transformation as a rank-2 update to A(i:n,i:n)
204 *
205  CALL cher2( 'Lower', n-i+1, -one, work, 1, work( n+1 ), 1,
206  \$ a( i, i ), lda )
207  40 CONTINUE
208 *
209 * Reduce number of subdiagonals to K
210 *
211  DO 60 i = 1, n - 1 - k
212 *
213 * generate reflection to annihilate A(k+i+1:n,i)
214 *
215  wn = scnrm2( n-k-i+1, a( k+i, i ), 1 )
216  wa = ( wn / abs( a( k+i, i ) ) )*a( k+i, i )
217  IF( wn.EQ.zero ) THEN
218  tau = zero
219  ELSE
220  wb = a( k+i, i ) + wa
221  CALL cscal( n-k-i, one / wb, a( k+i+1, i ), 1 )
222  a( k+i, i ) = one
223  tau = REAL( wb / wa )
224  END IF
225 *
226 * apply reflection to A(k+i:n,i+1:k+i-1) from the left
227 *
228  CALL cgemv( 'Conjugate transpose', n-k-i+1, k-1, one,
229  \$ a( k+i, i+1 ), lda, a( k+i, i ), 1, zero, work, 1 )
230  CALL cgerc( n-k-i+1, k-1, -tau, a( k+i, i ), 1, work, 1,
231  \$ a( k+i, i+1 ), lda )
232 *
233 * apply reflection to A(k+i:n,k+i:n) from the left and the right
234 *
235 * compute y := tau * A * u
236 *
237  CALL chemv( 'Lower', n-k-i+1, tau, a( k+i, k+i ), lda,
238  \$ a( k+i, i ), 1, zero, work, 1 )
239 *
240 * compute v := y - 1/2 * tau * ( y, u ) * u
241 *
242  alpha = -half*tau*cdotc( n-k-i+1, work, 1, a( k+i, i ), 1 )
243  CALL caxpy( n-k-i+1, alpha, a( k+i, i ), 1, work, 1 )
244 *
245 * apply hermitian rank-2 update to A(k+i:n,k+i:n)
246 *
247  CALL cher2( 'Lower', n-k-i+1, -one, a( k+i, i ), 1, work, 1,
248  \$ a( k+i, k+i ), lda )
249 *
250  a( k+i, i ) = -wa
251  DO 50 j = k + i + 1, n
252  a( j, i ) = zero
253  50 CONTINUE
254  60 CONTINUE
255 *
256 * Store full hermitian matrix
257 *
258  DO 80 j = 1, n
259  DO 70 i = j + 1, n
260  a( j, i ) = conjg( a( i, j ) )
261  70 CONTINUE
262  80 CONTINUE
263  RETURN
264 *
265 * End of CLAGHE
266 *
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:56
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:54
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: clarnv.f:101
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC
Definition: cgerc.f:132
complex function cdotc(N, CX, INCX, CY, INCY)
CDOTC
Definition: cdotc.f:54
subroutine chemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CHEMV
Definition: chemv.f:156
subroutine cher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CHER2
Definition: cher2.f:152
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
Definition: caxpy.f:53

Here is the call graph for this function:

Here is the caller graph for this function: