mirror of
https://github.com/LCPQ/quantum_package
synced 2025-01-10 21:18:29 +01:00
Accelerated Davidson
This commit is contained in:
parent
e1d2a79b3b
commit
df9efae335
@ -12,7 +12,7 @@ BEGIN_PROVIDER [ integer, davidson_sze_max]
|
||||
! Max number of Davidson sizes
|
||||
END_DOC
|
||||
ASSERT (davidson_sze_max <= davidson_iter_max)
|
||||
davidson_sze_max = 10
|
||||
davidson_sze_max = 4
|
||||
END_PROVIDER
|
||||
|
||||
subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
@ -40,7 +40,7 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
double precision, intent(out) :: energies(N_st)
|
||||
|
||||
integer :: iter
|
||||
integer :: i,j,k,l
|
||||
integer :: i,j,k,l,m
|
||||
logical :: converged
|
||||
|
||||
double precision :: overlap(N_st,N_st)
|
||||
@ -69,23 +69,9 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
ASSERT (sze > 0)
|
||||
ASSERT (Nint > 0)
|
||||
ASSERT (Nint == N_int)
|
||||
! Conventions:
|
||||
! i,j : 1,sze
|
||||
! k,l : 1,N_st
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(k,i) SHARED(U,u_in,sze,N_st)
|
||||
do k=1,N_st
|
||||
!$OMP DO
|
||||
do i=1,sze
|
||||
U(i,k,1) = u_in(i,k)
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! Orthonormalize initial guess
|
||||
! ============================
|
||||
! Initialization
|
||||
! ==============
|
||||
|
||||
k_pairs=0
|
||||
do l=1,N_st
|
||||
@ -95,48 +81,68 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
kl_pairs(2,k_pairs) = l
|
||||
enddo
|
||||
enddo
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||
!$OMP SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs) &
|
||||
!$OMP PRIVATE(k,l,kl)
|
||||
do kl=1,k_pairs
|
||||
k = kl_pairs(1,kl)
|
||||
l = kl_pairs(2,kl)
|
||||
if (k==l) then
|
||||
overlap(k,k) = u_dot_u(U(1,k,1),sze)
|
||||
endif
|
||||
overlap(k,l) = u_dot_v(U(1,k,1),U(1,l,1),sze)
|
||||
overlap(l,k) = overlap(k,l)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
call ortho_lowdin(overlap,size(overlap,1),N_st,U,size(U,1),sze)
|
||||
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i) &
|
||||
!$OMP SHARED(H_jj,Nint,dets_in,sze)
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs, &
|
||||
!$OMP H_jj,Nint,dets_in,u_in) &
|
||||
!$OMP PRIVATE(k,l,kl,i)
|
||||
|
||||
!$OMP DO
|
||||
do i=1,sze
|
||||
H_jj(i) = diag_h_mat_elem(dets_in(1,1,i),Nint)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
! Orthonormalize initial guess
|
||||
! ============================
|
||||
|
||||
!$OMP DO
|
||||
do kl=1,k_pairs
|
||||
k = kl_pairs(1,kl)
|
||||
l = kl_pairs(2,kl)
|
||||
if (k/=l) then
|
||||
overlap(k,l) = u_dot_v(U_in(1,k),U_in(1,l),sze)
|
||||
overlap(l,k) = overlap(k,l)
|
||||
else
|
||||
overlap(k,k) = u_dot_u(U_in(1,k),sze)
|
||||
endif
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
call ortho_lowdin(overlap,size(overlap,1),N_st,U_in,size(U_in,1),sze)
|
||||
|
||||
! Davidson iterations
|
||||
! ===================
|
||||
|
||||
converged = .False.
|
||||
|
||||
do while (.not.converged)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(k,i) SHARED(U,u_in,sze,N_st)
|
||||
do k=1,N_st
|
||||
!$OMP DO
|
||||
do i=1,sze
|
||||
U(i,k,1) = u_in(i,k)
|
||||
enddo
|
||||
!$OMP END DO
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do iter=1,davidson_sze_max-1
|
||||
print *, 'iter = ',iter
|
||||
|
||||
! print *, '***************'
|
||||
! do i=1,iter
|
||||
! do k=1,N_st
|
||||
! do j=1,iter
|
||||
! do l=1,N_st
|
||||
! print '(4(I4,X),F16.8)', i,j,k,l, u_dot_v(U(1,k,i),U(1,l,j),sze)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! print *, '***************'
|
||||
! print *, '***************'
|
||||
! do i=1,iter
|
||||
! do k=1,N_st
|
||||
! do j=1,iter
|
||||
! do l=1,N_st
|
||||
! print '(4(I4,X),F16.8)', i,j,k,l, u_dot_v(U(1,k,i),U(1,l,j),sze)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! print *, '***************'
|
||||
|
||||
! Compute W_k = H |u_k>
|
||||
! ----------------------
|
||||
@ -147,23 +153,34 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
|
||||
! Compute h_kl = <u_k | W_l> = <u_k| H |u_l>
|
||||
! -------------------------------------------
|
||||
|
||||
!$OMP PARALLEL
|
||||
!$OMP SINGLE
|
||||
do l=1,N_st
|
||||
do iter2=1,iter-1
|
||||
do k=1,N_st
|
||||
!$OMP TASK FIRSTPRIVATE(k,iter,l,iter2)
|
||||
h(k,iter2,l,iter) = u_dot_v(U(1,k,iter2),W(1,l),sze)
|
||||
h(k,iter,l,iter2) = h(k,iter2,l,iter)
|
||||
!$OMP END TASK
|
||||
enddo
|
||||
enddo
|
||||
do k=1,l
|
||||
!$OMP TASK FIRSTPRIVATE(k,iter,l)
|
||||
h(k,iter,l,iter) = u_dot_v(U(1,k,iter),W(1,l),sze)
|
||||
h(l,iter,k,iter) = h(k,iter,l,iter)
|
||||
!$OMP END TASK
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END SINGLE NOWAIT
|
||||
!$OMP TASKWAIT
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! Diagonalize h
|
||||
! -------------
|
||||
call lapack_diag(lambda,y,h,N_st*davidson_sze_max,N_st*iter)
|
||||
|
||||
print *, lambda(1:4)
|
||||
! Express eigenvectors of h in the determinant basis
|
||||
! --------------------------------------------------
|
||||
|
||||
@ -233,8 +250,15 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
enddo
|
||||
call normalize( U(1,k,iter+1), sze )
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
if (.not.converged) then
|
||||
iter = davidson_sze_max
|
||||
endif
|
||||
|
||||
! Re-contract to u_in
|
||||
! -----------
|
||||
|
||||
do k=1,N_st
|
||||
energies(k) = lambda(k)
|
||||
do i=1,sze
|
||||
@ -247,6 +271,8 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
deallocate ( &
|
||||
kl_pairs, &
|
||||
H_jj, &
|
||||
|
||||
@ -971,7 +971,7 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint)
|
||||
!$OMP PRIVATE(i,hij,j,k,idx,jj) SHARED(n,H_jj,u_0,keys_tmp,Nint)&
|
||||
!$OMP SHARED(v_0)
|
||||
allocate(idx(0:n))
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
!$OMP DO SCHEDULE(guided)
|
||||
do i=1,n
|
||||
v_0(i) = H_jj(i) * u_0(i)
|
||||
call filter_connected(keys_tmp,keys_tmp(1,1,i),Nint,n,idx)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user