10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-25 05:43:47 +01:00

MRCC fixed

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

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 integer :: l,jj
! do i=1,N_det double precision :: f
! h_matrix_dressed(i,j) = h_matrix_dressed(i,j) + & l = dressed_column_idx(1)
! 0.5d0 * (dressing_column_h(i,k) * psi_coef(j,k) + & f = 0.5d0/psi_coef(l,1)
! dressing_column_h(j,k) * psi_coef(i,k))
! enddo
! enddo
! enddo
integer :: l,jj
double precision :: f
do k=1,N_states
l = dressed_column_idx(k)
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

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

View File

@ -281,35 +281,53 @@ 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
call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & if (N_st == 1) then
psi_coef, size(psi_coef,1), &
U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & l = dressed_column_idx(1)
dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), & double precision :: f
1.d0, W(1,shift+1), size(W,1)) 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
call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & enddo
dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), &
1.d0, S(1,shift+1), size(S,1)) else
call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
psi_coef, size(psi_coef,1), &
U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, &
dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), &
1.d0, W(1,shift+1), size(W,1))
call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, &
dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), &
1.d0, S(1,shift+1), size(S,1))
call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
dressing_column_h, size(dressing_column_h,1), & dressing_column_h, size(dressing_column_h,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))
call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, &
psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
1.d0, W(1,shift+1), size(W,1)) 1.d0, W(1,shift+1), size(W,1))
call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
dressing_column_s, size(dressing_column_s,1), & dressing_column_s, size(dressing_column_s,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))
call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, &
psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
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>