LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-25 13:53:49 +01:00
Code Issues Releases Wiki Activity

MRCC fixed

Browse Source
This commit is contained in:
Anthony Scemama 2018-09-29 00:32:17 +02:00
parent db10fcceeb
commit 6de4260e17
3 changed files with 62 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
plugins/DavidsonDressed/diagonalize_CI.irp.f
View File

@ -176,29 +176,27 @@ BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det) ]
h_matrix_dressed(1:N_det,1:N_det) = h_matrix_all_dets(1:N_det,1:N_det) h_matrix_dressed(1:N_det,1:N_det) = h_matrix_all_dets(1:N_det,1:N_det)
! do k=1,N_states if (N_states == 1) then
! do j=1,N_det
! do i=1,N_det
! h_matrix_dressed(i,j) = h_matrix_dressed(i,j) + &
! 0.5d0 * (dressing_column_h(i,k) * psi_coef(j,k) + &
! dressing_column_h(j,k) * psi_coef(i,k))
! enddo
! enddo
! enddo
integer :: l,jj integer :: l,jj
double precision :: f double precision :: f
do k=1,N_states l = dressed_column_idx(1)
l = dressed_column_idx(k) f = 0.5d0/psi_coef(l,1)
f = 1.d0/psi_coef(l,k)
do i=1,N_det do i=1,N_det
if (i==l) cycle h_matrix_dressed(i,l) = h_matrix_dressed(i,l) + dressing_column_h(i,1) *f
h_matrix_dressed(i,l) = h_matrix_dressed(i,l) + dressing_column_h(i,k) *f h_matrix_dressed(l,i) = h_matrix_dressed(l,i) + dressing_column_h(i,1) *f
h_matrix_dressed(l,i) = h_matrix_dressed(l,i) + dressing_column_h(i,k) *f
h_matrix_dressed(l,l) = h_matrix_dressed(l,l) - psi_coef(i,k) * dressing_column_h(i,k) *f*f
enddo enddo
else
do k=1,N_states
do j=1,N_det
do i=1,N_det
h_matrix_dressed(i,j) = h_matrix_dressed(i,j) + &
0.5d0 *(dressing_column_h(i,k) * psi_coef(j,k) + &
dressing_column_h(j,k) * psi_coef(i,k))
enddo
enddo
enddo
endif
enddo
END_PROVIDER END_PROVIDER

7
plugins/mrcepa0/dressing_vector.irp.f
View File

@ -16,12 +16,15 @@
do k=1,N_states do k=1,N_states
integer :: jj integer :: jj
l = dressed_column_idx(k)
do jj=1,N_det_non_ref do jj=1,N_det_non_ref
j = idx_non_ref(jj) j = idx_non_ref(jj)
dressing_column_h(j,k) = delta_ij (k,jj) dressing_column_h(j,k) = 2.d0 * delta_ij (k,jj)
dressing_column_s(j,k) = delta_ij_s2(k,jj) dressing_column_s(j,k) = 2.d0 * delta_ij_s2(k,jj)
dressing_column_h(l,k) -= psi_coef(j,k) * delta_ij(k,jj) /psi_coef(l,k)
enddo enddo
enddo enddo
END_PROVIDER END_PROVIDER

18
src/Davidson/diagonalization_hs2_dressed.irp.f
View File

@ -281,6 +281,23 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
if (dressing_state > 0) then if (dressing_state > 0) then
if (N_st == 1) then
l = dressed_column_idx(1)
double precision :: f
f = 0.5d0/psi_coef(l,1)
do istate=1,N_st_diag
do i=1,sze
W(i,shift+istate) += dressing_column_h(i,1) *f * U(l,shift+istate)
W(l,shift+istate) += dressing_column_h(i,1) *f * U(i,shift+istate)
S(i,shift+istate) += dressing_column_s(i,1) *f * U(l,shift+istate)
S(l,shift+istate) += dressing_column_s(i,1) *f * U(i,shift+istate)
enddo
enddo
else
call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
psi_coef, size(psi_coef,1), & psi_coef, size(psi_coef,1), &
U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
@ -311,6 +328,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
1.d0, S(1,shift+1), size(S,1)) 1.d0, S(1,shift+1), size(S,1))
endif endif
endif
! Compute h_kl = <u_k | W_l> = <u_k| H |u_l> ! Compute h_kl = <u_k | W_l> = <u_k| H |u_l>
! ------------------------------------------- ! -------------------------------------------