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*> \date November 2017
135*
136*> \ingroup complexSYcomputational
137*
138*  =====================================================================
139      SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
140     $                             IPIV, IPIV2, B, LDB, INFO )
141*
142*  -- LAPACK computational routine (version 3.8.0) --
143*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
144*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
145*     November 2017
146*
147      IMPLICIT NONE
148*
149*     .. Scalar Arguments ..
150      CHARACTER          UPLO
151      INTEGER            N, NRHS, LDA, LTB, LDB, INFO
152*     ..
153*     .. Array Arguments ..
154      INTEGER            IPIV( * ), IPIV2( * )
155      COMPLEX            A( LDA, * ), TB( * ), B( LDB, * )
156*     ..
157*
158*  =====================================================================
159*
160      COMPLEX            ONE
161      PARAMETER          ( ONE  = ( 1.0E+0, 0.0E+0 ) )
162*     ..
163*     .. Local Scalars ..
164      INTEGER            LDTB, NB
165      LOGICAL            UPPER
166*     ..
167*     .. External Functions ..
168      LOGICAL            LSAME
169      EXTERNAL           LSAME
170*     ..
171*     .. External Subroutines ..
172      EXTERNAL           CGBTRS, CLASWP, CTRSM, XERBLA
173*     ..
174*     .. Intrinsic Functions ..
175      INTRINSIC          MAX
176*     ..
177*     .. Executable Statements ..
178*
179      INFO = 0
180      UPPER = LSAME( UPLO, 'U' )
181      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
182         INFO = -1
183      ELSE IF( N.LT.0 ) THEN
184         INFO = -2
185      ELSE IF( NRHS.LT.0 ) THEN
186         INFO = -3
187      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
188         INFO = -5
189      ELSE IF( LTB.LT.( 4*N ) ) THEN
190         INFO = -7
191      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
192         INFO = -11
193      END IF
194      IF( INFO.NE.0 ) THEN
195         CALL XERBLA( 'CSYTRS_AA_2STAGE', -INFO )
196         RETURN
197      END IF
198*
199*     Quick return if possible
200*
201      IF( N.EQ.0 .OR. NRHS.EQ.0 )
202     $   RETURN
203*
204*     Read NB and compute LDTB
205*
206      NB = INT( TB( 1 ) )
207      LDTB = LTB/N
208*
209      IF( UPPER ) THEN
210*
211*        Solve A*X = B, where A = U**T*T*U.
212*
213         IF( N.GT.NB ) THEN
214*
215*           Pivot, P**T * B -> B
216*
217            CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
218*
219*           Compute (U**T \ B) -> B    [ (U**T \P**T * B) ]
220*
221            CALL CTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1),
222     $                 LDA, B(NB+1, 1), LDB)
223*
224         END IF
225*
226*        Compute T \ B -> B   [ T \ (U**T \P**T * B) ]
227*
228         CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
229     $               INFO)
230         IF( N.GT.NB ) THEN
231*
232*           Compute (U \ B) -> B   [ U \ (T \ (U**T \P**T * B) ) ]
233*
234            CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
235     $                  LDA, B(NB+1, 1), LDB)
236*
237*           Pivot, P * B -> B  [ P * (U \ (T \ (U**T \P**T * B) )) ]
238*
239            CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
240*
241         END IF
242*
243      ELSE
244*
245*        Solve A*X = B, where A = L*T*L**T.
246*
247         IF( N.GT.NB ) THEN
248*
249*           Pivot, P**T * B -> B
250*
251            CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
252*
253*           Compute (L \ B) -> B    [ (L \P**T * B) ]
254*
255            CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
256     $                 LDA, B(NB+1, 1), LDB)
257*
258         END IF
259*
260*        Compute T \ B -> B   [ T \ (L \P**T * B) ]
261*
262         CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
263     $               INFO)
264         IF( N.GT.NB ) THEN
265*
266*           Compute (L**T \ B) -> B   [ L**T \ (T \ (L \P**T * B) ) ]
267*
268            CALL CTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
269     $                  LDA, B(NB+1, 1), LDB)
270*
271*           Pivot, P * B -> B  [ P * (L**T \ (T \ (L \P**T * B) )) ]
272*
273            CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
274*
275         END IF
276      END IF
277*
278      RETURN
279*
280*     End of CSYTRS_AA_2STAGE
281*
282      END
283