subroutine zppfa(ap,n,info) integer n,info complex*16 ap(1) c c zppfa factors a complex*16 hermitian positive definite matrix c stored in packed form. c c zppfa is usually called by zppco, but it can be called c directly with a saving in time if rcond is not needed. c (time for zppco) = (1 + 18/n)*(time for zppfa) . c c on entry c c ap complex*16 (n*(n+1)/2) c the packed form of a hermitian matrix a . the c columns of the upper triangle are stored sequentially c in a one-dimensional array of length n*(n+1)/2 . c see comments below for details. c c n integer c the order of the matrix a . c c on return c c ap an upper triangular matrix r , stored in packed c form, so that a = ctrans(r)*r . c c info integer c = 0 for normal return. c = k if the leading minor of order k is not c positive definite. c c c packed storage c c the following program segment will pack the upper c triangle of a hermitian matrix. c c k = 0 c do 20 j = 1, n c do 10 i = 1, j c k = k + 1 c ap(k) = a(i,j) c 10 continue c 20 continue c c linpack. this version dated 08/14/78 . c cleve moler, university of new mexico, argonne national lab. c c subroutines and functions c c blas zdotc c fortran dcmplx,dconjg,dsqrt c c internal variables c complex*16 zdotc,t double precision s integer j,jj,jm1,k,kj,kk double precision dreal,dimag complex*16 zdumr,zdumi dreal(zdumr) = zdumr dimag(zdumi) = (0.0d0,-1.0d0)*zdumi c begin block with ...exits to 40 c c jj = 0 do 30 j = 1, n info = j s = 0.0d0 jm1 = j - 1 kj = jj kk = 0 if (jm1 .lt. 1) go to 20 do 10 k = 1, jm1 kj = kj + 1 t = ap(kj) - zdotc(k-1,ap(kk+1),1,ap(jj+1),1) kk = kk + k t = t/ap(kk) ap(kj) = t s = s + dreal(t*dconjg(t)) 10 continue 20 continue jj = jj + j s = dreal(ap(jj)) - s c ......exit if (s .le. 0.0d0 .or. dimag(ap(jj)) .ne. 0.0d0) go to 40 ap(jj) = dcmplx(dsqrt(s),0.0d0) 30 continue info = 0 40 continue return end