c 1 2 3 4 5 6 7 c23456789012345678901234567890123456789012345678901234567890123456789012 c c Subroutine to perform Cholesky factorization c c 1 2 3 4 5 6 7 c23456789012345678901234567890123456789012345678901234567890123456789012 subroutine chlfct(m,xlindx,lindx,invp,perm,iwork,nnzdsub,jdsub, & colcnt,nsuper,snode,xsuper,nnzlmax,nsubmax, & xlnz,lnz,id,jd,d,cachsz,tmpmax,level, & tmpvec,split,ierr,it,timewd) integer m,ierr,nsub,iwsiz,nnzdsub,nnzl,nsuper,nnzlmax,nsubmax, & tmpsiz,cachsz,tmpmax,level,it, & xlindx(*),lindx(*),invp(*),perm(*),iwork(*),jdsub(*), & colcnt(*),snode(*),xsuper(*),xlnz(*),id(*),jd(*),split(*) double precision d(*),lnz(*),tmpvec(*),timewd(7) real gtimer,timbeg,timend external smxpy1,smxpy2,smxpy4,smxpy8 external mmpy1,mmpy2,mmpy4,mmpy8 c c Save the matrix structure from jdsub(m+2:nzzd+1),jdsub(1:m+1) c to lindx and xlindx because the matrix structure is destroyed by the c minimum degree ordering routine c do i = 1,m+1 xlindx(i) = jdsub(i) enddo do i = 1,nnzdsub lindx(i) = jdsub(m+1+i) enddo c c Reorder the matrix using minimum degree ordering routine c iwsiz = 4*m if(it .le. 1) then timbeg = gtimer() call ordmmd(m,xlindx,lindx,invp,perm,iwsiz,iwork,nsub,ierr) if (ierr .eq. -1) then ierr = 3 go to 100 endif timend = gtimer() timewd(1) = timewd(1) + timend - timbeg c c Call sfinit: Symbolic factorization initialization c to compute supernode partition and storage requirements c for symbolic factorization. New ordering is a postordering c of the nodal elimination tree c iwsiz = 7 * m + 3 timbeg = gtimer() call sfinit(m,nnzdsub,jdsub(1),jdsub(m+2),perm, & invp,colcnt,nnzl,nsub,nsuper,snode,xsuper,iwsiz, & iwork,ierr) if (ierr .eq. -1) then ierr = 4 go to 100 endif if (nnzl .gt. nnzlmax) then ierr = 5 go to 100 endif if (nsub .gt. nsubmax) then ierr = 6 go to 100 endif timend = gtimer() timewd(2) = timewd(2) + timend - timbeg endif c c Call symfct: Perform supernodal symbolic factorization c c iwsiz = nsuper + 2 * m + 1 timbeg = gtimer() call symfct(m,nnzdsub,jdsub(1),jdsub(m+2),perm,invp, & colcnt,nsuper,xsuper,snode,nsub,xlindx,lindx, & xlnz,iwsiz,iwork,ierr) if (ierr .eq. -1) then ierr = 7 go to 100 endif if (ierr .eq. -2) then ierr = 8 go to 100 endif timend = gtimer() timewd(3) = timewd(3) + timend - timbeg c c Call inpnv: Input numerical values into data structures of L c iwsiz = m timbeg = gtimer() call inpnv(m,id,jd,d,perm,invp,nsuper,xsuper,xlindx,lindx, & xlnz,lnz,iwork) timend = gtimer() timewd(4) = timewd(4) + timend - timbeg c c Call bfinit: Initialization for block factorization c timbeg = gtimer() call bfinit(m,nsuper,xsuper,snode,xlindx,lindx,cachsz,tmpsiz, & split) if (tmpsiz .gt. tmpmax) then ierr = 9 go to 100 endif timend = gtimer() timewd(5) = timewd(5) + timend - timbeg c c Call blkfct: Numerical factorization c iwsiz = 2 * m + 2 * nsuper timbeg = gtimer() if (level .eq. 1) then call blkfct(m,nsuper,xsuper,snode,split,xlindx,lindx,xlnz, & lnz,iwsiz,iwork,tmpsiz,tmpvec,ierr,mmpy1,smxpy1) elseif (level .eq. 2) then call blkfct(m,nsuper,xsuper,snode,split,xlindx,lindx,xlnz, & lnz,iwsiz,iwork,tmpsiz,tmpvec,ierr,mmpy2,smxpy2) elseif (level .eq. 4) then call blkfct(m,nsuper,xsuper,snode,split,xlindx,lindx,xlnz, & lnz,iwsiz,iwork,tmpsiz,tmpvec,ierr,mmpy4,smxpy4) elseif (level .eq. 8) then call blkfct(m,nsuper,xsuper,snode,split,xlindx,lindx,xlnz, & lnz,iwsiz,iwork,tmpsiz,tmpvec,ierr,mmpy8,smxpy8) endif if (ierr .eq. -1) then ierr = 10 go to 100 elseif (ierr .eq. -2) then ierr = 11 go to 100 elseif (ierr .eq. -3) then ierr = 12 go to 100 endif 100 continue timend = gtimer() timewd(6) = timewd(6) + timend - timbeg return end c