LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-29 16:34:50 +02:00
Code Issues Releases Wiki Activity

MRCC+PT2

Browse Source
This commit is contained in:
Anthony Scemama 2016-04-01 23:33:58 +02:00
parent dd8647d5aa
commit 27b7c34106
7 changed files with 155 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
plugins/MRCC_CASSD/mrcc_cassd.irp.f
View File

@ -1,15 +1,25 @@
program mrcc program mrcc
implicit none implicit none
double precision, allocatable :: energy(:)
allocate (energy(N_states))
read_wf = .True. read_wf = .True.
SOFT_TOUCH read_wf SOFT_TOUCH read_wf
call print_cas_coefs call print_cas_coefs
call set_generators_bitmasks_as_holes_and_particles call set_generators_bitmasks_as_holes_and_particles
call run call run(N_states,energy)
if(do_pt2_end)then
call run_pt2(N_states,energy)
endif
deallocate(energy)
end end
subroutine run subroutine run(N_st,energy)
implicit none implicit none
integer, intent(in) :: N_st
double precision, intent(out) :: energy(N_st)
integer :: i integer :: i
double precision :: E_new, E_old, delta_e double precision :: E_new, E_old, delta_e
@ -37,10 +47,54 @@ subroutine run
endif endif
enddo enddo
call write_double(6,ci_energy_dressed(1),"Final MRCC energy") call write_double(6,ci_energy_dressed(1),"Final MRCC energy")
energy(:) = ci_energy_dressed(:)
end end
subroutine run_pt2(N_st,energy)
implicit none
integer :: i,j,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
integer, intent(in) :: N_st
double precision, intent(in) :: energy(N_st)
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
pt2 = 0.d0
print*,'Last iteration only to compute the PT2'
threshold_selectors = 1.d0
threshold_generators = 0.999d0
N_det_generators = lambda_mrcc_pt2(0)
do i=1,N_det_generators
j = lambda_mrcc_pt2(i)
do k=1,N_int
psi_det_generators(k,1,i) = psi_non_ref(k,1,j)
psi_det_generators(k,2,i) = psi_non_ref(k,2,j)
enddo
do k=1,N_st
psi_coef_generators(i,k) = psi_non_ref_coef(j,k)
enddo
enddo
SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed
call H_apply_mrcc_PT2(pt2, norm_pert, H_pert_diag, N_st)
print *, 'Final step'
print *, 'N_det = ', N_det
print *, 'N_states = ', N_states
print *, 'PT2 = ', pt2
print *, 'E = ', energy
print *, 'E+PT2 = ', energy+pt2
print *, '-----'
call ezfio_set_full_ci_energy_pt2(energy+pt2)
deallocate(pt2,norm_pert)
end
subroutine print_cas_coefs subroutine print_cas_coefs
implicit none implicit none

55
plugins/MRCC_CASSD/mrcc_noiter.irp.f
View File

@ -1,17 +1,24 @@
program mrcc_noiter program mrcc_noiter
implicit none implicit none
double precision, allocatable :: energy(:)
allocate (energy(N_states))
read_wf = .True. read_wf = .True.
threshold_generators = .9999d0 threshold_generators = .9999d0
SOFT_TOUCH read_wf threshold_generators SOFT_TOUCH read_wf threshold_generators
call print_cas_coefs call print_cas_coefs
call set_generators_bitmasks_as_holes_and_particles call set_generators_bitmasks_as_holes_and_particles
call run call run(N_states,energy)
if(do_pt2_end)then
call run_pt2(N_states,energy)
endif
deallocate(energy)
end end
subroutine run subroutine run(N_st,energy)
implicit none implicit none
double precision :: lambda integer, intent(in) :: N_st
double precision, intent(out) :: energy(N_st)
integer :: i,j integer :: i,j
do j=1,N_states_diag do j=1,N_states_diag
do i=1,N_det do i=1,N_det
@ -22,6 +29,48 @@ subroutine run
call write_double(6,ci_energy_dressed(1),"Final MRCC energy") call write_double(6,ci_energy_dressed(1),"Final MRCC energy")
call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1))
call save_wavefunction call save_wavefunction
energy(:) = ci_energy_dressed(:)
end
subroutine run_pt2(N_st,energy)
implicit none
integer :: i,j,k
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
integer, intent(in) :: N_st
double precision, intent(in) :: energy(N_st)
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
pt2 = 0.d0
print*,'Last iteration only to compute the PT2'
threshold_selectors = 1.d0
threshold_generators = 0.999d0
N_det_generators = lambda_mrcc_pt2(0)
do i=1,N_det_generators
j = lambda_mrcc_pt2(i)
do k=1,N_int
psi_det_generators(k,1,i) = psi_non_ref(k,1,j)
psi_det_generators(k,2,i) = psi_non_ref(k,2,j)
enddo
do k=1,N_st
psi_coef_generators(i,k) = psi_non_ref_coef(j,k)
enddo
enddo
SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed
call H_apply_mrcc_PT2(pt2, norm_pert, H_pert_diag, N_st)
print *, 'Final step'
print *, 'N_det = ', N_det
print *, 'N_states = ', N_states
print *, 'PT2 = ', pt2
print *, 'E = ', energy
print *, 'E+PT2 = ', energy+pt2
print *, '-----'
call ezfio_set_full_ci_energy_pt2(energy+pt2)
deallocate(pt2,norm_pert)
end end

5
plugins/MRCC_Utils/davidson.irp.f
View File

@ -189,10 +189,10 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin
! Davidson iterations ! Davidson iterations
! =================== ! ===================
converged = .False.
integer :: iteration
converged = .False.
do while (.not.converged) do while (.not.converged)
!$OMP PARALLEL DEFAULT(NONE) & !$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE(k,i) SHARED(U,u_in,sze,N_st) !$OMP PRIVATE(k,i) SHARED(U,u_in,sze,N_st)
do k=1,N_st do k=1,N_st
@ -206,6 +206,7 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin
do iter=1,davidson_sze_max-1 do iter=1,davidson_sze_max-1
! Compute W_k = H |u_k> ! Compute W_k = H |u_k>
! ---------------------- ! ----------------------

15
plugins/MRCC_Utils/mrcc_utils.irp.f
View File

@ -1,15 +1,19 @@
BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ]
&BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m) ! cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
END_DOC END_DOC
integer :: i,k integer :: i,k
double precision :: ihpsi_current(N_states) double precision :: ihpsi_current(N_states)
integer :: i_pert_count integer :: i_pert_count
double precision :: hii, lambda_pert double precision :: hii, lambda_pert
integer :: N_lambda_mrcc_pt2
i_pert_count = 0 i_pert_count = 0
lambda_mrcc = 0.d0 lambda_mrcc = 0.d0
N_lambda_mrcc_pt2 = 0
lambda_mrcc_pt2(0) = 0
do i=1,N_det_non_ref do i=1,N_det_non_ref
call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef_normalized, N_int, N_det_ref,& call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef_normalized, N_int, N_det_ref,&
@ -24,9 +28,14 @@ BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ]
if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then
i_pert_count += 1 i_pert_count += 1
lambda_mrcc(k,i) = 0.d0 lambda_mrcc(k,i) = 0.d0
if (lambda_mrcc_pt2(N_lambda_mrcc_pt2) /= i) then
N_lambda_mrcc_pt2 += 1
lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i
endif
endif endif
enddo enddo
enddo enddo
lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2
print*,'N_det_non_ref = ',N_det_non_ref print*,'N_det_non_ref = ',N_det_non_ref
print*,'Number of ignored determinants = ',i_pert_count print*,'Number of ignored determinants = ',i_pert_count

14
plugins/Perturbation/perturbation.template.f
View File

@ -3,7 +3,7 @@ import perturbation
END_SHELL END_SHELL
subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp) subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp,electronic_energy)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply ! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply
@ -14,6 +14,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size) integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size)
integer(bit_kind),intent(in) :: key_mask(Nint,2) integer(bit_kind),intent(in) :: key_mask(Nint,2)
double precision, intent(in) :: fock_diag_tmp(2,0:mo_tot_num) double precision, intent(in) :: fock_diag_tmp(2,0:mo_tot_num)
double precision, intent(in) :: electronic_energy(N_st)
double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st) double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st)
double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st) double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st)
double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st) double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
@ -151,7 +152,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
idx_microlist_zero(ptr_microlist(1)+l) = idx_microlist(ptr_microlist(smallerlist)+l) idx_microlist_zero(ptr_microlist(1)+l) = idx_microlist(ptr_microlist(smallerlist)+l)
enddo enddo
end if end if
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & call pt2_$PERT(electronic_energy,psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0), & c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0), &
n_st,microlist_zero,idx_microlist_zero,N_microlist(smallerlist)+N_microlist(0)) n_st,microlist_zero,idx_microlist_zero,N_microlist(smallerlist)+N_microlist(0))
else else
@ -160,11 +161,11 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
cycle cycle
end if end if
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & call pt2_$PERT(electronic_energy,psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist)
end if end if
! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & ! call pt2_$PERT(electronic_energy,psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
! c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) ! c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist)
do k = 1,N_st do k = 1,N_st
@ -182,7 +183,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
end end
subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp) subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp,electronic_energy)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply ! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply
@ -193,6 +194,7 @@ subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_
integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size) integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size)
integer(bit_kind),intent(in) :: key_mask(Nint,2) integer(bit_kind),intent(in) :: key_mask(Nint,2)
double precision, intent(in) :: fock_diag_tmp(2,0:mo_tot_num) double precision, intent(in) :: fock_diag_tmp(2,0:mo_tot_num)
double precision, intent(in) :: electronic_energy(N_st)
double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st) double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st)
double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st) double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st)
double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st) double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
@ -241,7 +243,7 @@ subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_
cycle cycle
endif endif
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & call pt2_$PERT(electronic_energy,psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist)
do k = 1,N_st do k = 1,N_st

38
plugins/Perturbation/pt2_equations.irp.f
View File

@ -29,11 +29,11 @@ subroutine pt2_epstein_nesbet ($arguments)
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
do i =1,N_st do i =1,N_st
if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then if(electronic_energy(i)>h.and.electronic_energy(i).ne.0.d0)then
c_pert(i) = -1.d0 c_pert(i) = -1.d0
e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0 e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0
else if (dabs(CI_electronic_energy(i) - h) > 1.d-6) then else if (dabs(electronic_energy(i) - h) > 1.d-6) then
c_pert(i) = i_H_psi_array(i) / (CI_electronic_energy(i) - h) c_pert(i) = i_H_psi_array(i) / (electronic_energy(i) - h)
H_pert_diag(i) = h*c_pert(i)*c_pert(i) H_pert_diag(i) = h*c_pert(i)*c_pert(i)
e_2_pert(i) = c_pert(i) * i_H_psi_array(i) e_2_pert(i) = c_pert(i) * i_H_psi_array(i)
else else
@ -66,7 +66,6 @@ subroutine pt2_epstein_nesbet_2x2 ($arguments)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (Nint > 0) ASSERT (Nint > 0)
PROVIDE CI_electronic_energy
!call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
@ -74,7 +73,7 @@ subroutine pt2_epstein_nesbet_2x2 ($arguments)
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
do i =1,N_st do i =1,N_st
if (i_H_psi_array(i) /= 0.d0) then if (i_H_psi_array(i) /= 0.d0) then
delta_e = h - CI_electronic_energy(i) delta_e = h - electronic_energy(i)
if (delta_e > 0.d0) then if (delta_e > 0.d0) then
e_2_pert(i) = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * i_H_psi_array(i) * i_H_psi_array(i))) e_2_pert(i) = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * i_H_psi_array(i) * i_H_psi_array(i)))
else else
@ -165,7 +164,7 @@ subroutine pt2_epstein_nesbet_SC2_projected ($arguments)
! !
! that can be repeated by repeating all the double excitations ! that can be repeated by repeating all the double excitations
! !
! : you repeat all the correlation energy already taken into account in CI_electronic_energy(1) ! : you repeat all the correlation energy already taken into account in electronic_energy(1)
! !
! that could be repeated to this determinant. ! that could be repeated to this determinant.
! !
@ -195,16 +194,16 @@ subroutine pt2_epstein_nesbet_SC2_projected ($arguments)
enddo enddo
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
h = h + accu_e_corr h = h + accu_e_corr
delta_E = 1.d0/(CI_SC2_electronic_energy(1) - h) delta_E = 1.d0/(electronic_energy(1) - h)
c_pert(1) = i_H_psi_array(1) /(CI_SC2_electronic_energy(1) - h) c_pert(1) = i_H_psi_array(1) /(electronic_energy(1) - h)
e_2_pert(1) = i_H_psi_array(1) * c_pert(1) e_2_pert(1) = i_H_psi_array(1) * c_pert(1)
do i =2,N_st do i =2,N_st
H_pert_diag(i) = h H_pert_diag(i) = h
if (dabs(CI_SC2_electronic_energy(i) - h) > 1.d-6) then if (dabs(electronic_energy(i) - h) > 1.d-6) then
c_pert(i) = i_H_psi_array(i) / (-dabs(CI_SC2_electronic_energy(i) - h)) c_pert(i) = i_H_psi_array(i) / (-dabs(electronic_energy(i) - h))
e_2_pert(i) = (c_pert(i) * i_H_psi_array(i)) e_2_pert(i) = (c_pert(i) * i_H_psi_array(i))
else else
c_pert(i) = i_H_psi_array(i) c_pert(i) = i_H_psi_array(i)
@ -248,7 +247,7 @@ subroutine pt2_epstein_nesbet_SC2_no_projected ($arguments)
! !
! that can be repeated by repeating all the double excitations ! that can be repeated by repeating all the double excitations
! !
! : you repeat all the correlation energy already taken into account in CI_electronic_energy(1) ! : you repeat all the correlation energy already taken into account in electronic_energy(1)
! !
! that could be repeated to this determinant. ! that could be repeated to this determinant.
! !
@ -278,16 +277,16 @@ subroutine pt2_epstein_nesbet_SC2_no_projected ($arguments)
enddo enddo
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
h = h + accu_e_corr h = h + accu_e_corr
delta_E = 1.d0/(CI_SC2_electronic_energy(1) - h) delta_E = 1.d0/(electronic_energy(1) - h)
c_pert(1) = i_H_psi_array(1) /(CI_SC2_electronic_energy(1) - h) c_pert(1) = i_H_psi_array(1) /(electronic_energy(1) - h)
e_2_pert(1) = i_H_psi_array(1) * c_pert(1) e_2_pert(1) = i_H_psi_array(1) * c_pert(1)
do i =2,N_st do i =2,N_st
H_pert_diag(i) = h H_pert_diag(i) = h
if (dabs(CI_SC2_electronic_energy(i) - h) > 1.d-6) then if (dabs(electronic_energy(i) - h) > 1.d-6) then
c_pert(i) = i_H_psi_array(i) / (-dabs(CI_SC2_electronic_energy(i) - h)) c_pert(i) = i_H_psi_array(i) / (-dabs(electronic_energy(i) - h))
e_2_pert(i) = (c_pert(i) * i_H_psi_array(i)) e_2_pert(i) = (c_pert(i) * i_H_psi_array(i))
else else
c_pert(i) = i_H_psi_array(i) c_pert(i) = i_H_psi_array(i)
@ -328,11 +327,11 @@ subroutine pt2_epstein_nesbet_sc2 ($arguments)
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
do i =1,N_st do i =1,N_st
if(CI_SC2_electronic_energy(i)>h.and.CI_SC2_electronic_energy(i).ne.0.d0)then if(electronic_energy(i)>h.and.electronic_energy(i).ne.0.d0)then
c_pert(i) = -1.d0 c_pert(i) = -1.d0
e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0 e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0
else if (dabs(CI_SC2_electronic_energy(i) - h) > 1.d-6) then else if (dabs(electronic_energy(i) - h) > 1.d-6) then
c_pert(i) = i_H_psi_array(i) / (CI_SC2_electronic_energy(i) - h) c_pert(i) = i_H_psi_array(i) / (electronic_energy(i) - h)
H_pert_diag(i) = h*c_pert(i)*c_pert(i) H_pert_diag(i) = h*c_pert(i)*c_pert(i)
e_2_pert(i) = c_pert(i) * i_H_psi_array(i) e_2_pert(i) = c_pert(i) * i_H_psi_array(i)
else else
@ -348,7 +347,7 @@ end
SUBST [ arguments, declarations ] SUBST [ arguments, declarations ]
det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ; electronic_energy,det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ;
integer, intent(in) :: Nint integer, intent(in) :: Nint
integer, intent(in) :: ndet integer, intent(in) :: ndet
@ -357,6 +356,7 @@ det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minili
integer(bit_kind), intent(in) :: det_ref (Nint,2) integer(bit_kind), intent(in) :: det_ref (Nint,2)
integer(bit_kind), intent(in) :: det_pert(Nint,2) integer(bit_kind), intent(in) :: det_pert(Nint,2)
double precision , intent(in) :: fock_diag_tmp(2,mo_tot_num+1) double precision , intent(in) :: fock_diag_tmp(2,mo_tot_num+1)
double precision , intent(in) :: electronic_energy(N_st)
double precision , intent(out) :: c_pert(N_st) double precision , intent(out) :: c_pert(N_st)
double precision , intent(out) :: e_2_pert(N_st) double precision , intent(out) :: e_2_pert(N_st)
double precision, intent(out) :: H_pert_diag(N_st) double precision, intent(out) :: H_pert_diag(N_st)

9
scripts/generate_h_apply.py
View File

@ -61,6 +61,7 @@ class H_apply(object):
s["params_post"] = "" s["params_post"] = ""
self.selection_pt2 = None self.selection_pt2 = None
self.energy = "CI_electronic_energy"
self.perturbation = None self.perturbation = None
self.do_double_exc = do_double_exc self.do_double_exc = do_double_exc
#s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(NONE) & #s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(NONE) &
@ -264,13 +265,13 @@ class H_apply(object):
self.data["keys_work"] = """ self.data["keys_work"] = """
! if(check_double_excitation)then ! if(check_double_excitation)then
call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, & call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp) sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp,%s)
"""%(pert) """%(pert,self.energy)
else: else:
self.data["keys_work"] = """ self.data["keys_work"] = """
call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, & call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp) sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp,%s)
"""%(pert) """%(pert,self.energy)
self.data["finalization"] = """ self.data["finalization"] = """