https://github.com/cran/quantreg
Tip revision: d57ac843e4bb93cf7b5020287db6f854e6603a9a authored by Roger Koenker on 22 January 2021, 04:40:07 UTC
version 5.83
version 5.83
Tip revision: d57ac84
chlfct.f
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