Annotation of rpl/lapack/lapack/zsytrs_aa.f, revision 1.2
1.1 bertrand 1: *> \brief \b ZSYTRS_AA
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZSYTRS_AA + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrs_aa.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrs_aa.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrs_aa.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
22: * WORK, LWORK, INFO )
23: *
24: * .. Scalar Arguments ..
25: * CHARACTER UPLO
26: * INTEGER N, NRHS, LDA, LDB, LWORK, INFO
27: * ..
28: * .. Array Arguments ..
29: * INTEGER IPIV( * )
30: * COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
31: * ..
32: *
33: *
34: *> \par Purpose:
35: * =============
36: *>
37: *> \verbatim
38: *>
39: *> ZSYTRS_AA solves a system of linear equations A*X = B with a complex
40: *> symmetric matrix A using the factorization A = U*T*U**T or
41: *> A = L*T*L**T computed by ZSYTRF_AA.
42: *> \endverbatim
43: *
44: * Arguments:
45: * ==========
46: *
47: *> \param[in] UPLO
48: *> \verbatim
49: *> UPLO is CHARACTER*1
50: *> Specifies whether the details of the factorization are stored
51: *> as an upper or lower triangular matrix.
52: *> = 'U': Upper triangular, form is A = U*T*U**T;
53: *> = 'L': Lower triangular, form is A = L*T*L**T.
54: *> \endverbatim
55: *>
56: *> \param[in] N
57: *> \verbatim
58: *> N is INTEGER
59: *> The order of the matrix A. N >= 0.
60: *> \endverbatim
61: *>
62: *> \param[in] NRHS
63: *> \verbatim
64: *> NRHS is INTEGER
65: *> The number of right hand sides, i.e., the number of columns
66: *> of the matrix B. NRHS >= 0.
67: *> \endverbatim
68: *>
69: *> \param[in,out] A
70: *> \verbatim
71: *> A is COMPLEX*16 array, dimension (LDA,N)
72: *> Details of factors computed by ZSYTRF_AA.
73: *> \endverbatim
74: *>
75: *> \param[in] LDA
76: *> \verbatim
77: *> LDA is INTEGER
78: *> The leading dimension of the array A. LDA >= max(1,N).
79: *> \endverbatim
80: *>
81: *> \param[in] IPIV
82: *> \verbatim
83: *> IPIV is INTEGER array, dimension (N)
84: *> Details of the interchanges as computed by ZSYTRF_AA.
85: *> \endverbatim
86: *>
87: *> \param[in,out] B
88: *> \verbatim
89: *> B is COMPLEX*16 array, dimension (LDB,NRHS)
90: *> On entry, the right hand side matrix B.
91: *> On exit, the solution matrix X.
92: *> \endverbatim
93: *>
94: *> \param[in] LDB
95: *> \verbatim
96: *> LDB is INTEGER
97: *> The leading dimension of the array B. LDB >= max(1,N).
98: *> \endverbatim
99: *>
100: *> \param[in] WORK
101: *> \verbatim
102: *> WORK is DOUBLE array, dimension (MAX(1,LWORK))
103: *> \endverbatim
104: *>
105: *> \param[in] LWORK
106: *> \verbatim
107: *> LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
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 complex16SYcomputational
127: *
128: * =====================================================================
129: SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
130: $ WORK, LWORK, INFO )
131: *
132: * -- LAPACK computational routine (version 3.7.0) --
133: * -- LAPACK is a software package provided by Univ. of Tennessee, --
134: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
135: * December 2016
136: *
137: IMPLICIT NONE
138: *
139: * .. Scalar Arguments ..
140: CHARACTER UPLO
141: INTEGER N, NRHS, LDA, LDB, LWORK, INFO
142: * ..
143: * .. Array Arguments ..
144: INTEGER IPIV( * )
145: COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
146: * ..
147: *
148: * =====================================================================
149: *
150: COMPLEX*16 ONE
151: PARAMETER ( ONE = 1.0D+0 )
152: * ..
153: * .. Local Scalars ..
154: LOGICAL LQUERY, UPPER
155: INTEGER K, KP, LWKOPT
156: * ..
157: * .. External Functions ..
158: LOGICAL LSAME
159: EXTERNAL LSAME
160: * ..
161: * .. External Subroutines ..
162: EXTERNAL ZGTSV, ZSWAP, ZTRSM, XERBLA
163: * ..
164: * .. Intrinsic Functions ..
165: INTRINSIC MAX
166: * ..
167: * .. Executable Statements ..
168: *
169: INFO = 0
170: UPPER = LSAME( UPLO, 'U' )
171: LQUERY = ( LWORK.EQ.-1 )
172: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
173: INFO = -1
174: ELSE IF( N.LT.0 ) THEN
175: INFO = -2
176: ELSE IF( NRHS.LT.0 ) THEN
177: INFO = -3
178: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
179: INFO = -5
180: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
181: INFO = -8
182: ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
183: INFO = -10
184: END IF
185: IF( INFO.NE.0 ) THEN
186: CALL XERBLA( 'ZSYTRS_AA', -INFO )
187: RETURN
188: ELSE IF( LQUERY ) THEN
189: LWKOPT = (3*N-2)
190: WORK( 1 ) = LWKOPT
191: RETURN
192: END IF
193: *
194: * Quick return if possible
195: *
196: IF( N.EQ.0 .OR. NRHS.EQ.0 )
197: $ RETURN
198: *
199: IF( UPPER ) THEN
200: *
201: * Solve A*X = B, where A = U*T*U**T.
202: *
203: * Pivot, P**T * B
204: *
205: DO K = 1, N
206: KP = IPIV( K )
207: IF( KP.NE.K )
208: $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
209: END DO
210: *
211: * Compute (U \P**T * B) -> B [ (U \P**T * B) ]
212: *
213: CALL ZTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
214: $ B( 2, 1 ), LDB)
215: *
216: * Compute T \ B -> B [ T \ (U \P**T * B) ]
217: *
218: CALL ZLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1)
219: IF( N.GT.1 ) THEN
220: CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 )
221: CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1 )
222: END IF
223: CALL ZGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB,
224: $ INFO )
225: *
226: * Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ]
227: *
228: CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
229: $ B( 2, 1 ), LDB)
230: *
231: * Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ]
232: *
233: DO K = N, 1, -1
234: KP = IPIV( K )
235: IF( KP.NE.K )
236: $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
237: END DO
238: *
239: ELSE
240: *
241: * Solve A*X = B, where A = L*T*L**T.
242: *
243: * Pivot, P**T * B
244: *
245: DO K = 1, N
246: KP = IPIV( K )
247: IF( KP.NE.K )
248: $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
249: END DO
250: *
251: * Compute (L \P**T * B) -> B [ (L \P**T * B) ]
252: *
253: CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
254: $ B( 2, 1 ), LDB)
255: *
256: * Compute T \ B -> B [ T \ (L \P**T * B) ]
257: *
258: CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
259: IF( N.GT.1 ) THEN
260: CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 )
261: CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1 )
262: END IF
263: CALL ZGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB,
264: $ INFO)
265: *
266: * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
267: *
268: CALL ZTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
269: $ B( 2, 1 ), LDB)
270: *
271: * Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
272: *
273: DO K = N, 1, -1
274: KP = IPIV( K )
275: IF( KP.NE.K )
276: $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
277: END DO
278: *
279: END IF
280: *
281: RETURN
282: *
283: * End of ZSYTRS_AA
284: *
285: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zsytrs_aa.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack