diff --git a/src/ao_two_e_ints/cholesky.irp.f b/src/ao_two_e_ints/cholesky.irp.f index 77eb6ddc..2d2a40ab 100644 --- a/src/ao_two_e_ints/cholesky.irp.f +++ b/src/ao_two_e_ints/cholesky.irp.f @@ -1,10 +1,28 @@ -BEGIN_PROVIDER [ integer, cholesky_ao_num_guess ] +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 ] implicit none BEGIN_DOC ! Number of Cholesky vectors in AO basis 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 BEGIN_PROVIDER [ integer, cholesky_ao_num ] @@ -103,8 +121,10 @@ END_PROVIDER ! Call Lapack cholesky_ao_num = cholesky_ao_num_guess - call pivoted_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), ' %)' +! 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), ' %)' ! Remove mmap double precision, external :: getUnitAndOpen @@ -131,3 +151,172 @@ BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num, enddo 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