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