LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

Beginning new way for computing pt2

This commit is contained in:
Emmanuel Giner 2016-09-10 12:32:33 +02:00
parent 9121d1a604
commit 9a152ca037
5 changed files with 32 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/ifort.cfg
View File

@ -18,7 +18,7 @@ IRPF90_FLAGS : --ninja --align=32
# 0 : Deactivate
#
[OPTION]
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
CACHE : 1 ; Enable cache_compile.py
OPENMP : 1 ; Append OpenMP flags

2
plugins/MRPT_Utils/excitations_cas.irp.f
View File

@ -398,8 +398,6 @@ subroutine u0_H_dyall_u0(energies,psi_in,psi_in_coef,ndet,dim_psi_in,dim_psi_coe
do j = 1, ndet
if(psi_coef_tmp(j)==0.d0)cycle
call i_H_j_dyall(psi_in(1,1,i),psi_in(1,1,j),N_int,hij)
! call i_H_j(psi_in(1,1,i),psi_in(1,1,j),N_int,hij_bis)
! print*, hij_bis,hij
accu += psi_coef_tmp(i) * psi_coef_tmp(j) * hij
enddo
enddo

15
plugins/MRPT_Utils/mrpt_dress.irp.f
View File

@ -44,6 +44,8 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip
integer :: N_miniList, leng
double precision :: delta_e(N_states),hij_tmp
integer :: index_i,index_j
double precision :: phase_array(N_det),phase
integer :: exc(0:2,2,2),degree
leng = max(N_det_generators, N_det)
@ -74,11 +76,14 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip
! double precision :: ihpsi0,coef_pert
! ihpsi0 = 0.d0
! coef_pert = 0.d0
phase_array =0.d0
do i = 1,idx_alpha(0)
index_i = idx_alpha(i)
call get_delta_e_dyall(psi_det(1,1,index_i),tq(1,1,i_alpha),delta_e)
call i_h_j(tq(1,1,i_alpha),psi_det(1,1,index_i),Nint,hialpha)
hij_array(index_i) = hialpha
call get_excitation(psi_det(1,1,index_i),tq(1,1,i_alpha),exc,degree,phase,N_int)
! phase_array(index_i) = phase
do i_state = 1,N_states
delta_e_inv_array(index_i,i_state) = 1.d0/delta_e(i_state)
enddo
@ -90,6 +95,16 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip
call omp_set_lock( psi_ref_bis_lock(index_i) )
do j = 1, idx_alpha(0)
index_j = idx_alpha(j)
! call get_excitation(psi_det(1,1,index_i),psi_det(1,1,index_i),exc,degree,phase,N_int)
! if(index_j.ne.index_i)then
! if(phase_array(index_j) * phase_array(index_i) .ne. phase)then
! print*, phase_array(index_j) , phase_array(index_i) ,phase
! call debug_det(psi_det(1,1,index_i),N_int)
! call debug_det(psi_det(1,1,index_j),N_int)
! call debug_det(tq(1,1,i_alpha),N_int)
! stop
! endif
! endif
do i_state=1,N_states
! standard dressing first order
delta_ij_(index_i,index_j,i_state) += hij_array(index_j) * hij_tmp * delta_e_inv_array(index_j,i_state)

6
plugins/MRPT_Utils/psi_active_prov.irp.f
View File

@ -180,6 +180,8 @@ subroutine get_delta_e_dyall(det_1,det_2,delta_e_final)
double precision :: delta_e_inactive(N_states)
integer :: i_hole_inact
call give_holes_in_inactive_space(det_2,n_holes_spin,n_holes,holes_list)
delta_e_inactive = 0.d0
do i = 1, n_holes_spin(1)
@ -429,7 +431,7 @@ subroutine get_delta_e_dyall(det_1,det_2,delta_e_final)
do i_state = 1, n_states
delta_e_final(i_state) = delta_e_act(i_state) + delta_e_inactive(i_state) - delta_e_virt(i_state)
enddo
delta_e_final(i_state) = delta_e_act(i_state) + delta_e_inactive(i_state) - delta_e_virt(i_state)
enddo
end

12
src/Determinants/slater_rules.irp.f
View File

@ -749,6 +749,7 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble)
exc(1,2,2) ,mo_integrals_map)
else if (exc(0,1,1) == 2) then
! Double alpha
print*,'phase hij = ',phase
hij = phase*(get_mo_bielec_integral_schwartz( &
exc(1,1,1), &
exc(2,1,1), &
@ -759,6 +760,17 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble)
exc(2,1,1), &
exc(2,2,1), &
exc(1,2,1) ,mo_integrals_map) )
print*,get_mo_bielec_integral_schwartz( &
exc(1,1,1), &
exc(2,1,1), &
exc(1,2,1), &
exc(2,2,1) ,mo_integrals_map)
print*,get_mo_bielec_integral_schwartz( &
exc(1,1,1), &
exc(2,1,1), &
exc(2,2,1), &
exc(1,2,1) ,mo_integrals_map)
else if (exc(0,1,2) == 2) then
! Double beta
hij = phase*(get_mo_bielec_integral_schwartz( &