1*> \brief \b CPBSTF
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CPBSTF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpbstf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpbstf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpbstf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CPBSTF( UPLO, N, KD, AB, LDAB, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            INFO, KD, LDAB, N
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX            AB( LDAB, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CPBSTF computes a split Cholesky factorization of a complex
38*> Hermitian positive definite band matrix A.
39*>
40*> This routine is designed to be used in conjunction with CHBGST.
41*>
42*> The factorization has the form  A = S**H*S  where S is a band matrix
43*> of the same bandwidth as A and the following structure:
44*>
45*>   S = ( U    )
46*>       ( M  L )
47*>
48*> where U is upper triangular of order m = (n+kd)/2, and L is lower
49*> triangular of order n-m.
50*> \endverbatim
51*
52*  Arguments:
53*  ==========
54*
55*> \param[in] UPLO
56*> \verbatim
57*>          UPLO is CHARACTER*1
58*>          = 'U':  Upper triangle of A is stored;
59*>          = 'L':  Lower triangle of A is stored.
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*>          N is INTEGER
65*>          The order of the matrix A.  N >= 0.
66*> \endverbatim
67*>
68*> \param[in] KD
69*> \verbatim
70*>          KD is INTEGER
71*>          The number of superdiagonals of the matrix A if UPLO = 'U',
72*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
73*> \endverbatim
74*>
75*> \param[in,out] AB
76*> \verbatim
77*>          AB is COMPLEX array, dimension (LDAB,N)
78*>          On entry, the upper or lower triangle of the Hermitian band
79*>          matrix A, stored in the first kd+1 rows of the array.  The
80*>          j-th column of A is stored in the j-th column of the array AB
81*>          as follows:
82*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
83*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
84*>
85*>          On exit, if INFO = 0, the factor S from the split Cholesky
86*>          factorization A = S**H*S. See Further Details.
87*> \endverbatim
88*>
89*> \param[in] LDAB
90*> \verbatim
91*>          LDAB is INTEGER
92*>          The leading dimension of the array AB.  LDAB >= KD+1.
93*> \endverbatim
94*>
95*> \param[out] INFO
96*> \verbatim
97*>          INFO is INTEGER
98*>          = 0: successful exit
99*>          < 0: if INFO = -i, the i-th argument had an illegal value
100*>          > 0: if INFO = i, the factorization could not be completed,
101*>               because the updated element a(i,i) was negative; the
102*>               matrix A is not positive definite.
103*> \endverbatim
104*
105*  Authors:
106*  ========
107*
108*> \author Univ. of Tennessee
109*> \author Univ. of California Berkeley
110*> \author Univ. of Colorado Denver
111*> \author NAG Ltd.
112*
113*> \date November 2011
114*
115*> \ingroup complexOTHERcomputational
116*
117*> \par Further Details:
118*  =====================
119*>
120*> \verbatim
121*>
122*>  The band storage scheme is illustrated by the following example, when
123*>  N = 7, KD = 2:
124*>
125*>  S = ( s11  s12  s13                     )
126*>      (      s22  s23  s24                )
127*>      (           s33  s34                )
128*>      (                s44                )
129*>      (           s53  s54  s55           )
130*>      (                s64  s65  s66      )
131*>      (                     s75  s76  s77 )
132*>
133*>  If UPLO = 'U', the array AB holds:
134*>
135*>  on entry:                          on exit:
136*>
137*>   *    *   a13  a24  a35  a46  a57   *    *   s13  s24  s53**H s64**H s75**H
138*>   *   a12  a23  a34  a45  a56  a67   *   s12  s23  s34  s54**H s65**H s76**H
139*>  a11  a22  a33  a44  a55  a66  a77  s11  s22  s33  s44  s55    s66    s77
140*>
141*>  If UPLO = 'L', the array AB holds:
142*>
143*>  on entry:                          on exit:
144*>
145*>  a11  a22  a33  a44  a55  a66  a77  s11    s22    s33    s44  s55  s66  s77
146*>  a21  a32  a43  a54  a65  a76   *   s12**H s23**H s34**H s54  s65  s76   *
147*>  a31  a42  a53  a64  a64   *    *   s13**H s24**H s53    s64  s75   *    *
148*>
149*>  Array elements marked * are not used by the routine; s12**H denotes
150*>  conjg(s12); the diagonal elements of S are real.
151*> \endverbatim
152*>
153*  =====================================================================
154      SUBROUTINE CPBSTF( UPLO, N, KD, AB, LDAB, INFO )
155*
156*  -- LAPACK computational routine (version 3.4.0) --
157*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
158*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
159*     November 2011
160*
161*     .. Scalar Arguments ..
162      CHARACTER          UPLO
163      INTEGER            INFO, KD, LDAB, N
164*     ..
165*     .. Array Arguments ..
166      COMPLEX            AB( LDAB, * )
167*     ..
168*
169*  =====================================================================
170*
171*     .. Parameters ..
172      REAL               ONE, ZERO
173      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
174*     ..
175*     .. Local Scalars ..
176      LOGICAL            UPPER
177      INTEGER            J, KLD, KM, M
178      REAL               AJJ
179*     ..
180*     .. External Functions ..
181      LOGICAL            LSAME
182      EXTERNAL           LSAME
183*     ..
184*     .. External Subroutines ..
185      EXTERNAL           CHER, CLACGV, CSSCAL, XERBLA
186*     ..
187*     .. Intrinsic Functions ..
188      INTRINSIC          MAX, MIN, REAL, SQRT
189*     ..
190*     .. Executable Statements ..
191*
192*     Test the input parameters.
193*
194      INFO = 0
195      UPPER = LSAME( UPLO, 'U' )
196      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
197         INFO = -1
198      ELSE IF( N.LT.0 ) THEN
199         INFO = -2
200      ELSE IF( KD.LT.0 ) THEN
201         INFO = -3
202      ELSE IF( LDAB.LT.KD+1 ) THEN
203         INFO = -5
204      END IF
205      IF( INFO.NE.0 ) THEN
206         CALL XERBLA( 'CPBSTF', -INFO )
207         RETURN
208      END IF
209*
210*     Quick return if possible
211*
212      IF( N.EQ.0 )
213     $   RETURN
214*
215      KLD = MAX( 1, LDAB-1 )
216*
217*     Set the splitting point m.
218*
219      M = ( N+KD ) / 2
220*
221      IF( UPPER ) THEN
222*
223*        Factorize A(m+1:n,m+1:n) as L**H*L, and update A(1:m,1:m).
224*
225         DO 10 J = N, M + 1, -1
226*
227*           Compute s(j,j) and test for non-positive-definiteness.
228*
229            AJJ = REAL( AB( KD+1, J ) )
230            IF( AJJ.LE.ZERO ) THEN
231               AB( KD+1, J ) = AJJ
232               GO TO 50
233            END IF
234            AJJ = SQRT( AJJ )
235            AB( KD+1, J ) = AJJ
236            KM = MIN( J-1, KD )
237*
238*           Compute elements j-km:j-1 of the j-th column and update the
239*           the leading submatrix within the band.
240*
241            CALL CSSCAL( KM, ONE / AJJ, AB( KD+1-KM, J ), 1 )
242            CALL CHER( 'Upper', KM, -ONE, AB( KD+1-KM, J ), 1,
243     $                 AB( KD+1, J-KM ), KLD )
244   10    CONTINUE
245*
246*        Factorize the updated submatrix A(1:m,1:m) as U**H*U.
247*
248         DO 20 J = 1, M
249*
250*           Compute s(j,j) and test for non-positive-definiteness.
251*
252            AJJ = REAL( AB( KD+1, J ) )
253            IF( AJJ.LE.ZERO ) THEN
254               AB( KD+1, J ) = AJJ
255               GO TO 50
256            END IF
257            AJJ = SQRT( AJJ )
258            AB( KD+1, J ) = AJJ
259            KM = MIN( KD, M-J )
260*
261*           Compute elements j+1:j+km of the j-th row and update the
262*           trailing submatrix within the band.
263*
264            IF( KM.GT.0 ) THEN
265               CALL CSSCAL( KM, ONE / AJJ, AB( KD, J+1 ), KLD )
266               CALL CLACGV( KM, AB( KD, J+1 ), KLD )
267               CALL CHER( 'Upper', KM, -ONE, AB( KD, J+1 ), KLD,
268     $                    AB( KD+1, J+1 ), KLD )
269               CALL CLACGV( KM, AB( KD, J+1 ), KLD )
270            END IF
271   20    CONTINUE
272      ELSE
273*
274*        Factorize A(m+1:n,m+1:n) as L**H*L, and update A(1:m,1:m).
275*
276         DO 30 J = N, M + 1, -1
277*
278*           Compute s(j,j) and test for non-positive-definiteness.
279*
280            AJJ = REAL( AB( 1, J ) )
281            IF( AJJ.LE.ZERO ) THEN
282               AB( 1, J ) = AJJ
283               GO TO 50
284            END IF
285            AJJ = SQRT( AJJ )
286            AB( 1, J ) = AJJ
287            KM = MIN( J-1, KD )
288*
289*           Compute elements j-km:j-1 of the j-th row and update the
290*           trailing submatrix within the band.
291*
292            CALL CSSCAL( KM, ONE / AJJ, AB( KM+1, J-KM ), KLD )
293            CALL CLACGV( KM, AB( KM+1, J-KM ), KLD )
294            CALL CHER( 'Lower', KM, -ONE, AB( KM+1, J-KM ), KLD,
295     $                 AB( 1, J-KM ), KLD )
296            CALL CLACGV( KM, AB( KM+1, J-KM ), KLD )
297   30    CONTINUE
298*
299*        Factorize the updated submatrix A(1:m,1:m) as U**H*U.
300*
301         DO 40 J = 1, M
302*
303*           Compute s(j,j) and test for non-positive-definiteness.
304*
305            AJJ = REAL( AB( 1, J ) )
306            IF( AJJ.LE.ZERO ) THEN
307               AB( 1, J ) = AJJ
308               GO TO 50
309            END IF
310            AJJ = SQRT( AJJ )
311            AB( 1, J ) = AJJ
312            KM = MIN( KD, M-J )
313*
314*           Compute elements j+1:j+km of the j-th column and update the
315*           trailing submatrix within the band.
316*
317            IF( KM.GT.0 ) THEN
318               CALL CSSCAL( KM, ONE / AJJ, AB( 2, J ), 1 )
319               CALL CHER( 'Lower', KM, -ONE, AB( 2, J ), 1,
320     $                    AB( 1, J+1 ), KLD )
321            END IF
322   40    CONTINUE
323      END IF
324      RETURN
325*
326   50 CONTINUE
327      INFO = J
328      RETURN
329*
330*     End of CPBSTF
331*
332      END
333