2019-06-28 16:51:16 +02:00
|
|
|
program print_2rdm
|
|
|
|
|
implicit none
|
|
|
|
|
read_wf = .True.
|
|
|
|
|
touch read_wf
|
2019-06-28 20:45:07 +02:00
|
|
|
call routine
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
subroutine routine
|
2019-06-28 16:51:16 +02:00
|
|
|
integer :: i,j,k,l
|
2019-06-28 20:45:07 +02:00
|
|
|
integer :: ii,jj,kk,ll
|
2019-06-28 16:51:16 +02:00
|
|
|
double precision :: accu(4),twodm,thr,act_twodm2,integral,get_two_e_integral
|
|
|
|
|
thr = 1.d-10
|
|
|
|
|
|
2019-06-28 20:45:07 +02:00
|
|
|
|
2019-06-28 16:51:16 +02:00
|
|
|
accu = 0.d0
|
2019-06-28 20:45:07 +02:00
|
|
|
do ll = 1, n_act_orb
|
|
|
|
|
l = list_act(ll)
|
|
|
|
|
do kk = 1, n_act_orb
|
|
|
|
|
k = list_act(kk)
|
|
|
|
|
do jj = 1, n_act_orb
|
|
|
|
|
j = list_act(jj)
|
|
|
|
|
do ii = 1, n_act_orb
|
|
|
|
|
i = list_act(ii)
|
2019-06-28 16:51:16 +02:00
|
|
|
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
2019-06-28 20:45:07 +02:00
|
|
|
accu(1) += act_two_rdm_spin_trace_mo(ii,jj,kk,ll) * integral
|
|
|
|
|
!if(dabs(act_two_rdm_spin_trace_mo(ii,jj,kk,ll)).gt.thr)then
|
|
|
|
|
!print*,'',ii,jj,kk,ll,act_two_rdm_spin_trace_mo(ii,jj,kk,ll)*integral
|
|
|
|
|
!print*,'accu',accu(1)
|
|
|
|
|
!endif
|
2019-06-28 16:51:16 +02:00
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
2019-06-28 20:45:07 +02:00
|
|
|
print*,'accu = ',accu(1)
|
|
|
|
|
print*,'psi_energy_two_e = ',psi_energy_two_e
|
|
|
|
|
!double precision :: hij
|
|
|
|
|
!call i_H_j_double_alpha_beta(psi_det(1,1,1),psi_det(1,1,2),N_int,hij)
|
|
|
|
|
!print*,'hij * 2',hij * psi_coef(1,1) * psi_coef(2,1) * 2.d0
|
|
|
|
|
!print*,'psi diag = ',psi_energy_two_e - hij * psi_coef(1,1) * psi_coef(2,1) * 2.d0
|
2019-06-28 16:51:16 +02:00
|
|
|
end
|
