10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-15 02:23:51 +01:00

Accelerated Cholesky

This commit is contained in:
Anthony Scemama 2023-07-03 19:54:00 +02:00
parent 487e85c6ae
commit 3c7a10934f
4 changed files with 30 additions and 18 deletions

2
external/ezfio vendored

@ -1 +1 @@
Subproject commit 0520b5e2cf70e2451c37ce5b7f2f64f6d2e5e956
Subproject commit ed1df9f3c1f51752656ca98da5693a4119add05c

2
external/irpf90 vendored

@ -1 +1 @@
Subproject commit 0007f72f677fe7d61c5e1ed461882cb239517102
Subproject commit 33ca5e1018f3bbb5e695e6ee558f5dac0753b271

@ -1 +1 @@
Subproject commit e0d0e02e9f5ece138d1520106954a881ab0b8db2
Subproject commit f40bde0925808bbec0424b57bfcef1b26473a1c8

View File

@ -73,7 +73,7 @@ subroutine direct_cholesky(L, ndim, rank, tau)
double precision, parameter :: s = 1.d-2
double precision, parameter :: dscale = 1.d0
double precision, allocatable :: D(:), Delta(:,:)
double precision, allocatable :: D(:), Delta(:,:), Ltmp_p(:,:), Ltmp_q(:,:)
integer, allocatable :: Lset(:), Dset(:), addr(:,:)
integer :: i,j,k,m,p,q, qj, dj
@ -138,7 +138,16 @@ subroutine direct_cholesky(L, ndim, rank, tau)
enddo
! d., e.
allocate(Delta(np,nq))
allocate(Delta(np,nq), Ltmp_p(max(np,1),max(N,1)), Ltmp_q(max(nq,1),max(N,1)))
do k=1,N
do p=1,np
Ltmp_p(p,k) = L(Lset(p),k)
enddo
do q=1,nq
Ltmp_q(q,k) = L(Dset(q),k)
enddo
enddo
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(m,k)
do m=1,nq
do k=1,np
@ -149,17 +158,13 @@ subroutine direct_cholesky(L, ndim, rank, tau)
addr(2,Dset(m)), &
ao_integrals_map)
enddo
do p=1,N
f = L(Dset(m),p)
do k=1,np
Delta(k,m) = Delta(k,m) - L(Lset(k),p) * f
enddo
enddo
enddo
!$OMP END PARALLEL DO
! f.
call dgemm('N','T',np,nq,N,-1.d0, &
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
! f.
Qmax = D(Dset(1))
do q=1,nq
Qmax = max(Qmax, D(Dset(q)))
@ -184,19 +189,26 @@ subroutine direct_cholesky(L, ndim, rank, tau)
! iii.
f = 1.d0/dsqrt(Qmax)
do p=1,np
L(Lset(p), rank) = Delta(p,dj) * f
Ltmp_p(p,1) = Delta(p,dj) * f
L(Lset(p), rank) = Ltmp_p(p,1)
enddo
do q=1,nq
Ltmp_q(q,1) = L(Dset(q), rank)
enddo
! iv.
! call dger(np, nq, -1.d0, Ltmp_p, 1, Ltmp_q, 1, Delta, np)
!$OMP PARALLEL DO PRIVATE(f,m,k)
do m=1, nq
f = L(Dset(m),rank)
do k=1, np
Delta(k,m) = Delta(k,m) - L(Lset(k),rank) * f
Delta(k,m) = Delta(k,m) - Ltmp_p(k,1) * Ltmp_q(m,1)
enddo
enddo
!$OMP END PARALLEL DO
do k=1, np
D(Lset(k)) = D(Lset(k)) - L(Lset(k),rank) * L(Lset(k),rank)
D(Lset(k)) = D(Lset(k)) - Ltmp_p(k,1) * Ltmp_p(k,1)
enddo
Qmax = D(Dset(1))
@ -206,7 +218,7 @@ subroutine direct_cholesky(L, ndim, rank, tau)
enddo
deallocate(Delta)
deallocate(Delta, Ltmp_p, Ltmp_q)
! i.
N = N+j