mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 20:23:40 +02:00
Rewrote Cholesky
This commit is contained in:
parent
f30ed6bf43
commit
d911f4eee8
@ -1,10 +1,28 @@
|
|||||||
|
BEGIN_PROVIDER [ integer, mini_basis_size, (128) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Size of the minimal basis set per element
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
mini_basis_size(1:2) = 1
|
||||||
|
mini_basis_size(3:4) = 2
|
||||||
|
mini_basis_size(5:10) = 5
|
||||||
|
mini_basis_size(11:12) = 6
|
||||||
|
mini_basis_size(13:18) = 9
|
||||||
|
mini_basis_size(19:20) = 13
|
||||||
|
mini_basis_size(21:36) = 18
|
||||||
|
mini_basis_size(37:38) = 22
|
||||||
|
mini_basis_size(39:54) = 27
|
||||||
|
mini_basis_size(55:) = 36
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, cholesky_ao_num_guess ]
|
BEGIN_PROVIDER [ integer, cholesky_ao_num_guess ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Number of Cholesky vectors in AO basis
|
! Number of Cholesky vectors in AO basis
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
cholesky_ao_num_guess = ao_num*ao_num
|
cholesky_ao_num_guess = ao_num*ao_num !sum(mini_basis_size(int(nucl_charge(:))))
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
|
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
|
||||||
@ -103,7 +121,9 @@ END_PROVIDER
|
|||||||
|
|
||||||
! Call Lapack
|
! Call Lapack
|
||||||
cholesky_ao_num = cholesky_ao_num_guess
|
cholesky_ao_num = cholesky_ao_num_guess
|
||||||
call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
|
! call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
|
||||||
|
|
||||||
|
call direct_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
|
||||||
print *, 'Rank : ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
|
print *, 'Rank : ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
|
||||||
|
|
||||||
! Remove mmap
|
! Remove mmap
|
||||||
@ -131,3 +151,172 @@ BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num,
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
subroutine direct_cholesky( A, rank, tau, ndim, L)
|
||||||
|
implicit none
|
||||||
|
integer :: ndim
|
||||||
|
integer, intent(inout) :: rank
|
||||||
|
double precision, intent(inout) :: A(ndim, ndim)
|
||||||
|
double precision, intent(out) :: L(ndim, rank)
|
||||||
|
double precision, intent(in) :: tau
|
||||||
|
|
||||||
|
double precision, parameter :: s = 1.d-2
|
||||||
|
double precision, parameter :: dscale = 1.d0
|
||||||
|
|
||||||
|
double precision, allocatable :: D(:), Delta(:,:)
|
||||||
|
integer, allocatable :: Lset(:), Dset(:)
|
||||||
|
|
||||||
|
integer :: i,j,k,m,p,q, qj, dj
|
||||||
|
integer :: N, np, nq
|
||||||
|
|
||||||
|
double precision :: Dmax, Dmin, Qmax, f
|
||||||
|
allocate( D(ndim), Lset(ndim), Dset(ndim) )
|
||||||
|
|
||||||
|
L = 0.d0
|
||||||
|
|
||||||
|
! 1.
|
||||||
|
do i=1,ndim
|
||||||
|
D(i) = A(i,i)
|
||||||
|
enddo
|
||||||
|
Dmax = maxval(D)
|
||||||
|
! print *, '# 1. ', D
|
||||||
|
! print *, '# 1. ', Dmax
|
||||||
|
|
||||||
|
! 2.
|
||||||
|
np=0
|
||||||
|
do p=1,ndim
|
||||||
|
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
|
||||||
|
np = np+1
|
||||||
|
Lset(np) = p
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
! print *, '# 2. ', Lset(:np)
|
||||||
|
|
||||||
|
! 3.
|
||||||
|
N = 0
|
||||||
|
! print *, '# 3. ', N
|
||||||
|
|
||||||
|
! 4.
|
||||||
|
i = 0
|
||||||
|
! print *, '# 4. ', i
|
||||||
|
|
||||||
|
! 5.
|
||||||
|
do while (Dmax > tau)
|
||||||
|
! a.
|
||||||
|
i = i+1
|
||||||
|
! print *, '# 5.a ', i
|
||||||
|
|
||||||
|
! b.
|
||||||
|
Dmin = max(s*Dmax, tau)
|
||||||
|
! print *, '# 5.b ', Dmin
|
||||||
|
|
||||||
|
! c.
|
||||||
|
nq=0
|
||||||
|
do q=1,np
|
||||||
|
if ( D(Lset(q)) > Dmin ) then
|
||||||
|
nq = nq+1
|
||||||
|
Dset(nq) = Lset(q)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
! print *, '# 5.c ', Dset(:nq)
|
||||||
|
|
||||||
|
! d.
|
||||||
|
allocate(Delta(np,nq))
|
||||||
|
do m=1,nq
|
||||||
|
do k=1,np
|
||||||
|
Delta(k,m) = A(Lset(k), Dset(m))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! print *, '# 5.d ', Delta
|
||||||
|
|
||||||
|
! e.
|
||||||
|
do m=1,nq
|
||||||
|
do k=1,np
|
||||||
|
do p=1,N
|
||||||
|
Delta(k,m) = Delta(k,m) - L(Lset(k),p) * L(Dset(m),p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! print *, '# 5.e ', Delta
|
||||||
|
|
||||||
|
! f.
|
||||||
|
Qmax = D(Dset(1))
|
||||||
|
do q=1,nq
|
||||||
|
Qmax = max(Qmax, D(Dset(q)))
|
||||||
|
enddo
|
||||||
|
! print *, '# 5.f ', Qmax
|
||||||
|
|
||||||
|
! g.
|
||||||
|
j = 0
|
||||||
|
! print *, '# 5.g ', j
|
||||||
|
|
||||||
|
do while ( (j <= nq).and.(Qmax > Dmin) )
|
||||||
|
! i.
|
||||||
|
j = j+1
|
||||||
|
rank = N+j
|
||||||
|
! print *, '# 5.h.i ', j, rank
|
||||||
|
|
||||||
|
! ii.
|
||||||
|
do dj=1,nq
|
||||||
|
qj = Dset(dj)
|
||||||
|
if (D(qj) == Qmax) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
! print *, ' # 5.h.ii ', qj, dj
|
||||||
|
|
||||||
|
! iii.
|
||||||
|
f = 1.d0/dsqrt(Qmax)
|
||||||
|
do p=1,np
|
||||||
|
L(Lset(p), rank) = Delta(p,dj) * f
|
||||||
|
enddo
|
||||||
|
! print *, ' # 5.h.iii '
|
||||||
|
! do k=1,20
|
||||||
|
! print *, L(k,1:rank)
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! iv.
|
||||||
|
do m=1, nq
|
||||||
|
do k=1, np
|
||||||
|
Delta(k,m) = Delta(k,m) - L(Lset(k),rank) * L(Dset(m),rank)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k=1, np
|
||||||
|
D(Lset(k)) = D(Lset(k)) - L(Lset(k),rank) * L(Lset(k),rank)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
Qmax = D(Dset(1))
|
||||||
|
do q=1,np
|
||||||
|
Qmax = max(Qmax, D(Lset(q)))
|
||||||
|
enddo
|
||||||
|
! print *, '# 5.h.iv ', Delta
|
||||||
|
! print *, '# 5.h.iv ', D
|
||||||
|
! print *, '# 5.h.iv ', Qmax
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(Delta)
|
||||||
|
|
||||||
|
! i.
|
||||||
|
N = N+j
|
||||||
|
! print *, '# 5.i ', N
|
||||||
|
|
||||||
|
! j.
|
||||||
|
Dmax = D(Lset(1))
|
||||||
|
do p=1,np
|
||||||
|
Dmax = max(Dmax, D(Lset(p)))
|
||||||
|
enddo
|
||||||
|
! print *, '# 5.j ', Dmax
|
||||||
|
|
||||||
|
np=0
|
||||||
|
do p=1,ndim
|
||||||
|
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
|
||||||
|
np = np+1
|
||||||
|
Lset(np) = p
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
! print *, '# k. ', Lset(:np)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
Loading…
Reference in New Issue
Block a user