1: *> \brief \b ZHEGST
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZHEGST + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhegst.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhegst.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhegst.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
22: *
23: * .. Scalar Arguments ..
24: * CHARACTER UPLO
25: * INTEGER INFO, ITYPE, LDA, LDB, N
26: * ..
27: * .. Array Arguments ..
28: * COMPLEX*16 A( LDA, * ), B( LDB, * )
29: * ..
30: *
31: *
32: *> \par Purpose:
33: * =============
34: *>
35: *> \verbatim
36: *>
37: *> ZHEGST reduces a complex Hermitian-definite generalized
38: *> eigenproblem to standard form.
39: *>
40: *> If ITYPE = 1, the problem is A*x = lambda*B*x,
41: *> and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H)
42: *>
43: *> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
44: *> B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H*A*L.
45: *>
46: *> B must have been previously factorized as U**H*U or L*L**H by ZPOTRF.
47: *> \endverbatim
48: *
49: * Arguments:
50: * ==========
51: *
52: *> \param[in] ITYPE
53: *> \verbatim
54: *> ITYPE is INTEGER
55: *> = 1: compute inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H);
56: *> = 2 or 3: compute U*A*U**H or L**H*A*L.
57: *> \endverbatim
58: *>
59: *> \param[in] UPLO
60: *> \verbatim
61: *> UPLO is CHARACTER*1
62: *> = 'U': Upper triangle of A is stored and B is factored as
63: *> U**H*U;
64: *> = 'L': Lower triangle of A is stored and B is factored as
65: *> L*L**H.
66: *> \endverbatim
67: *>
68: *> \param[in] N
69: *> \verbatim
70: *> N is INTEGER
71: *> The order of the matrices A and B. N >= 0.
72: *> \endverbatim
73: *>
74: *> \param[in,out] A
75: *> \verbatim
76: *> A is COMPLEX*16 array, dimension (LDA,N)
77: *> On entry, the Hermitian matrix A. If UPLO = 'U', the leading
78: *> N-by-N upper triangular part of A contains the upper
79: *> triangular part of the matrix A, and the strictly lower
80: *> triangular part of A is not referenced. If UPLO = 'L', the
81: *> leading N-by-N lower triangular part of A contains the lower
82: *> triangular part of the matrix A, and the strictly upper
83: *> triangular part of A is not referenced.
84: *>
85: *> On exit, if INFO = 0, the transformed matrix, stored in the
86: *> same format as A.
87: *> \endverbatim
88: *>
89: *> \param[in] LDA
90: *> \verbatim
91: *> LDA is INTEGER
92: *> The leading dimension of the array A. LDA >= max(1,N).
93: *> \endverbatim
94: *>
95: *> \param[in,out] B
96: *> \verbatim
97: *> B is COMPLEX*16 array, dimension (LDB,N)
98: *> The triangular factor from the Cholesky factorization of B,
99: *> as returned by ZPOTRF.
100: *> B is modified by the routine but restored on exit.
101: *> \endverbatim
102: *>
103: *> \param[in] LDB
104: *> \verbatim
105: *> LDB is INTEGER
106: *> The leading dimension of the array B. LDB >= max(1,N).
107: *> \endverbatim
108: *>
109: *> \param[out] INFO
110: *> \verbatim
111: *> INFO is INTEGER
112: *> = 0: successful exit
113: *> < 0: if INFO = -i, the i-th argument had an illegal value
114: *> \endverbatim
115: *
116: * Authors:
117: * ========
118: *
119: *> \author Univ. of Tennessee
120: *> \author Univ. of California Berkeley
121: *> \author Univ. of Colorado Denver
122: *> \author NAG Ltd.
123: *
124: *> \date December 2016
125: *
126: *> \ingroup complex16HEcomputational
127: *
128: * =====================================================================
129: SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
130: *
131: * -- LAPACK computational routine (version 3.7.0) --
132: * -- LAPACK is a software package provided by Univ. of Tennessee, --
133: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134: * December 2016
135: *
136: * .. Scalar Arguments ..
137: CHARACTER UPLO
138: INTEGER INFO, ITYPE, LDA, LDB, N
139: * ..
140: * .. Array Arguments ..
141: COMPLEX*16 A( LDA, * ), B( LDB, * )
142: * ..
143: *
144: * =====================================================================
145: *
146: * .. Parameters ..
147: DOUBLE PRECISION ONE
148: PARAMETER ( ONE = 1.0D+0 )
149: COMPLEX*16 CONE, HALF
150: PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ),
151: $ HALF = ( 0.5D+0, 0.0D+0 ) )
152: * ..
153: * .. Local Scalars ..
154: LOGICAL UPPER
155: INTEGER K, KB, NB
156: * ..
157: * .. External Subroutines ..
158: EXTERNAL XERBLA, ZHEGS2, ZHEMM, ZHER2K, ZTRMM, ZTRSM
159: * ..
160: * .. Intrinsic Functions ..
161: INTRINSIC MAX, MIN
162: * ..
163: * .. External Functions ..
164: LOGICAL LSAME
165: INTEGER ILAENV
166: EXTERNAL LSAME, ILAENV
167: * ..
168: * .. Executable Statements ..
169: *
170: * Test the input parameters.
171: *
172: INFO = 0
173: UPPER = LSAME( UPLO, 'U' )
174: IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
175: INFO = -1
176: ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
177: INFO = -2
178: ELSE IF( N.LT.0 ) THEN
179: INFO = -3
180: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
181: INFO = -5
182: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
183: INFO = -7
184: END IF
185: IF( INFO.NE.0 ) THEN
186: CALL XERBLA( 'ZHEGST', -INFO )
187: RETURN
188: END IF
189: *
190: * Quick return if possible
191: *
192: IF( N.EQ.0 )
193: $ RETURN
194: *
195: * Determine the block size for this environment.
196: *
197: NB = ILAENV( 1, 'ZHEGST', UPLO, N, -1, -1, -1 )
198: *
199: IF( NB.LE.1 .OR. NB.GE.N ) THEN
200: *
201: * Use unblocked code
202: *
203: CALL ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
204: ELSE
205: *
206: * Use blocked code
207: *
208: IF( ITYPE.EQ.1 ) THEN
209: IF( UPPER ) THEN
210: *
211: * Compute inv(U**H)*A*inv(U)
212: *
213: DO 10 K = 1, N, NB
214: KB = MIN( N-K+1, NB )
215: *
216: * Update the upper triangle of A(k:n,k:n)
217: *
218: CALL ZHEGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
219: $ B( K, K ), LDB, INFO )
220: IF( K+KB.LE.N ) THEN
221: CALL ZTRSM( 'Left', UPLO, 'Conjugate transpose',
222: $ 'Non-unit', KB, N-K-KB+1, CONE,
223: $ B( K, K ), LDB, A( K, K+KB ), LDA )
224: CALL ZHEMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
225: $ A( K, K ), LDA, B( K, K+KB ), LDB,
226: $ CONE, A( K, K+KB ), LDA )
227: CALL ZHER2K( UPLO, 'Conjugate transpose', N-K-KB+1,
228: $ KB, -CONE, A( K, K+KB ), LDA,
229: $ B( K, K+KB ), LDB, ONE,
230: $ A( K+KB, K+KB ), LDA )
231: CALL ZHEMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
232: $ A( K, K ), LDA, B( K, K+KB ), LDB,
233: $ CONE, A( K, K+KB ), LDA )
234: CALL ZTRSM( 'Right', UPLO, 'No transpose',
235: $ 'Non-unit', KB, N-K-KB+1, CONE,
236: $ B( K+KB, K+KB ), LDB, A( K, K+KB ),
237: $ LDA )
238: END IF
239: 10 CONTINUE
240: ELSE
241: *
242: * Compute inv(L)*A*inv(L**H)
243: *
244: DO 20 K = 1, N, NB
245: KB = MIN( N-K+1, NB )
246: *
247: * Update the lower triangle of A(k:n,k:n)
248: *
249: CALL ZHEGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
250: $ B( K, K ), LDB, INFO )
251: IF( K+KB.LE.N ) THEN
252: CALL ZTRSM( 'Right', UPLO, 'Conjugate transpose',
253: $ 'Non-unit', N-K-KB+1, KB, CONE,
254: $ B( K, K ), LDB, A( K+KB, K ), LDA )
255: CALL ZHEMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
256: $ A( K, K ), LDA, B( K+KB, K ), LDB,
257: $ CONE, A( K+KB, K ), LDA )
258: CALL ZHER2K( UPLO, 'No transpose', N-K-KB+1, KB,
259: $ -CONE, A( K+KB, K ), LDA,
260: $ B( K+KB, K ), LDB, ONE,
261: $ A( K+KB, K+KB ), LDA )
262: CALL ZHEMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
263: $ A( K, K ), LDA, B( K+KB, K ), LDB,
264: $ CONE, A( K+KB, K ), LDA )
265: CALL ZTRSM( 'Left', UPLO, 'No transpose',
266: $ 'Non-unit', N-K-KB+1, KB, CONE,
267: $ B( K+KB, K+KB ), LDB, A( K+KB, K ),
268: $ LDA )
269: END IF
270: 20 CONTINUE
271: END IF
272: ELSE
273: IF( UPPER ) THEN
274: *
275: * Compute U*A*U**H
276: *
277: DO 30 K = 1, N, NB
278: KB = MIN( N-K+1, NB )
279: *
280: * Update the upper triangle of A(1:k+kb-1,1:k+kb-1)
281: *
282: CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Non-unit',
283: $ K-1, KB, CONE, B, LDB, A( 1, K ), LDA )
284: CALL ZHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
285: $ LDA, B( 1, K ), LDB, CONE, A( 1, K ),
286: $ LDA )
287: CALL ZHER2K( UPLO, 'No transpose', K-1, KB, CONE,
288: $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A,
289: $ LDA )
290: CALL ZHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
291: $ LDA, B( 1, K ), LDB, CONE, A( 1, K ),
292: $ LDA )
293: CALL ZTRMM( 'Right', UPLO, 'Conjugate transpose',
294: $ 'Non-unit', K-1, KB, CONE, B( K, K ), LDB,
295: $ A( 1, K ), LDA )
296: CALL ZHEGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
297: $ B( K, K ), LDB, INFO )
298: 30 CONTINUE
299: ELSE
300: *
301: * Compute L**H*A*L
302: *
303: DO 40 K = 1, N, NB
304: KB = MIN( N-K+1, NB )
305: *
306: * Update the lower triangle of A(1:k+kb-1,1:k+kb-1)
307: *
308: CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Non-unit',
309: $ KB, K-1, CONE, B, LDB, A( K, 1 ), LDA )
310: CALL ZHEMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
311: $ LDA, B( K, 1 ), LDB, CONE, A( K, 1 ),
312: $ LDA )
313: CALL ZHER2K( UPLO, 'Conjugate transpose', K-1, KB,
314: $ CONE, A( K, 1 ), LDA, B( K, 1 ), LDB,
315: $ ONE, A, LDA )
316: CALL ZHEMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
317: $ LDA, B( K, 1 ), LDB, CONE, A( K, 1 ),
318: $ LDA )
319: CALL ZTRMM( 'Left', UPLO, 'Conjugate transpose',
320: $ 'Non-unit', KB, K-1, CONE, B( K, K ), LDB,
321: $ A( K, 1 ), LDA )
322: CALL ZHEGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
323: $ B( K, K ), LDB, INFO )
324: 40 CONTINUE
325: END IF
326: END IF
327: END IF
328: RETURN
329: *
330: * End of ZHEGST
331: *
332: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zhegst.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack