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*> \ingroup complexOTHERcomputational
114*
115*> \par Further Details:
116*  =====================
117*>
118*> \verbatim
119*>
120*>  The band storage scheme is illustrated by the following example, when
121*>  N = 7, KD = 2:
122*>
123*>  S = ( s11  s12  s13                     )
124*>      (      s22  s23  s24                )
125*>      (           s33  s34                )
126*>      (                s44                )
127*>      (           s53  s54  s55           )
128*>      (                s64  s65  s66      )
129*>      (                     s75  s76  s77 )
130*>
131*>  If UPLO = 'U', the array AB holds:
132*>
133*>  on entry:                          on exit:
134*>
135*>   *    *   a13  a24  a35  a46  a57   *    *   s13  s24  s53**H s64**H s75**H
136*>   *   a12  a23  a34  a45  a56  a67   *   s12  s23  s34  s54**H s65**H s76**H
137*>  a11  a22  a33  a44  a55  a66  a77  s11  s22  s33  s44  s55    s66    s77
138*>
139*>  If UPLO = 'L', the array AB holds:
140*>
141*>  on entry:                          on exit:
142*>
143*>  a11  a22  a33  a44  a55  a66  a77  s11    s22    s33    s44  s55  s66  s77
144*>  a21  a32  a43  a54  a65  a76   *   s12**H s23**H s34**H s54  s65  s76   *
145*>  a31  a42  a53  a64  a64   *    *   s13**H s24**H s53    s64  s75   *    *
146*>
147*>  Array elements marked * are not used by the routine; s12**H denotes
148*>  conjg(s12); the diagonal elements of S are real.
149*> \endverbatim
150*>
151*  =====================================================================
152      SUBROUTINE CPBSTF( UPLO, N, KD, AB, LDAB, INFO )
153*
154*  -- LAPACK computational routine --
155*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
156*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
157*
158*     .. Scalar Arguments ..
159      CHARACTER          UPLO
160      INTEGER            INFO, KD, LDAB, N
161*     ..
162*     .. Array Arguments ..
163      COMPLEX            AB( LDAB, * )
164*     ..
165*
166*  =====================================================================
167*
168*     .. Parameters ..
169      REAL               ONE, ZERO
170      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
171*     ..
172*     .. Local Scalars ..
173      LOGICAL            UPPER
174      INTEGER            J, KLD, KM, M
175      REAL               AJJ
176*     ..
177*     .. External Functions ..
178      LOGICAL            LSAME
179      EXTERNAL           LSAME
180*     ..
181*     .. External Subroutines ..
182      EXTERNAL           CHER, CLACGV, CSSCAL, XERBLA
183*     ..
184*     .. Intrinsic Functions ..
185      INTRINSIC          MAX, MIN, REAL, SQRT
186*     ..
187*     .. Executable Statements ..
188*
189*     Test the input parameters.
190*
191      INFO = 0
192      UPPER = LSAME( UPLO, 'U' )
193      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
194         INFO = -1
195      ELSE IF( N.LT.0 ) THEN
196         INFO = -2
197      ELSE IF( KD.LT.0 ) THEN
198         INFO = -3
199      ELSE IF( LDAB.LT.KD+1 ) THEN
200         INFO = -5
201      END IF
202      IF( INFO.NE.0 ) THEN
203         CALL XERBLA( 'CPBSTF', -INFO )
204         RETURN
205      END IF
206*
207*     Quick return if possible
208*
209      IF( N.EQ.0 )
210     $   RETURN
211*
212      KLD = MAX( 1, LDAB-1 )
213*
214*     Set the splitting point m.
215*
216      M = ( N+KD ) / 2
217*
218      IF( UPPER ) THEN
219*
220*        Factorize A(m+1:n,m+1:n) as L**H*L, and update A(1:m,1:m).
221*
222         DO 10 J = N, M + 1, -1
223*
224*           Compute s(j,j) and test for non-positive-definiteness.
225*
226            AJJ = REAL( AB( KD+1, J ) )
227            IF( AJJ.LE.ZERO ) THEN
228               AB( KD+1, J ) = AJJ
229               GO TO 50
230            END IF
231            AJJ = SQRT( AJJ )
232            AB( KD+1, J ) = AJJ
233            KM = MIN( J-1, KD )
234*
235*           Compute elements j-km:j-1 of the j-th column and update the
236*           the leading submatrix within the band.
237*
238            CALL CSSCAL( KM, ONE / AJJ, AB( KD+1-KM, J ), 1 )
239            CALL CHER( 'Upper', KM, -ONE, AB( KD+1-KM, J ), 1,
240     $                 AB( KD+1, J-KM ), KLD )
241   10    CONTINUE
242*
243*        Factorize the updated submatrix A(1:m,1:m) as U**H*U.
244*
245         DO 20 J = 1, M
246*
247*           Compute s(j,j) and test for non-positive-definiteness.
248*
249            AJJ = REAL( AB( KD+1, J ) )
250            IF( AJJ.LE.ZERO ) THEN
251               AB( KD+1, J ) = AJJ
252               GO TO 50
253            END IF
254            AJJ = SQRT( AJJ )
255            AB( KD+1, J ) = AJJ
256            KM = MIN( KD, M-J )
257*
258*           Compute elements j+1:j+km of the j-th row and update the
259*           trailing submatrix within the band.
260*
261            IF( KM.GT.0 ) THEN
262               CALL CSSCAL( KM, ONE / AJJ, AB( KD, J+1 ), KLD )
263               CALL CLACGV( KM, AB( KD, J+1 ), KLD )
264               CALL CHER( 'Upper', KM, -ONE, AB( KD, J+1 ), KLD,
265     $                    AB( KD+1, J+1 ), KLD )
266               CALL CLACGV( KM, AB( KD, J+1 ), KLD )
267            END IF
268   20    CONTINUE
269      ELSE
270*
271*        Factorize A(m+1:n,m+1:n) as L**H*L, and update A(1:m,1:m).
272*
273         DO 30 J = N, M + 1, -1
274*
275*           Compute s(j,j) and test for non-positive-definiteness.
276*
277            AJJ = REAL( AB( 1, J ) )
278            IF( AJJ.LE.ZERO ) THEN
279               AB( 1, J ) = AJJ
280               GO TO 50
281            END IF
282            AJJ = SQRT( AJJ )
283            AB( 1, J ) = AJJ
284            KM = MIN( J-1, KD )
285*
286*           Compute elements j-km:j-1 of the j-th row and update the
287*           trailing submatrix within the band.
288*
289            CALL CSSCAL( KM, ONE / AJJ, AB( KM+1, J-KM ), KLD )
290            CALL CLACGV( KM, AB( KM+1, J-KM ), KLD )
291            CALL CHER( 'Lower', KM, -ONE, AB( KM+1, J-KM ), KLD,
292     $                 AB( 1, J-KM ), KLD )
293            CALL CLACGV( KM, AB( KM+1, J-KM ), KLD )
294   30    CONTINUE
295*
296*        Factorize the updated submatrix A(1:m,1:m) as U**H*U.
297*
298         DO 40 J = 1, M
299*
300*           Compute s(j,j) and test for non-positive-definiteness.
301*
302            AJJ = REAL( AB( 1, J ) )
303            IF( AJJ.LE.ZERO ) THEN
304               AB( 1, J ) = AJJ
305               GO TO 50
306            END IF
307            AJJ = SQRT( AJJ )
308            AB( 1, J ) = AJJ
309            KM = MIN( KD, M-J )
310*
311*           Compute elements j+1:j+km of the j-th column and update the
312*           trailing submatrix within the band.
313*
314            IF( KM.GT.0 ) THEN
315               CALL CSSCAL( KM, ONE / AJJ, AB( 2, J ), 1 )
316               CALL CHER( 'Lower', KM, -ONE, AB( 2, J ), 1,
317     $                    AB( 1, J+1 ), KLD )
318            END IF
319   40    CONTINUE
320      END IF
321      RETURN
322*
323   50 CONTINUE
324      INFO = J
325      RETURN
326*
327*     End of CPBSTF
328*
329      END
330