2019-06-28 16:51:16 +02:00
|
|
|
program print_2rdm
|
|
|
|
|
implicit none
|
2019-06-29 17:29:32 +02:00
|
|
|
BEGIN_DOC
|
|
|
|
|
! get the active part of the bielectronic energy on a given wave function.
|
|
|
|
|
!
|
|
|
|
|
! useful to test the active part of the spin trace 2 rdms
|
|
|
|
|
END_DOC
|
2019-10-25 01:30:30 +02:00
|
|
|
!no_vvvv_integrals = .True.
|
2019-06-28 16:51:16 +02:00
|
|
|
read_wf = .True.
|
2019-10-25 01:30:30 +02:00
|
|
|
!touch read_wf no_vvvv_integrals
|
2019-10-22 18:56:26 +02:00
|
|
|
!call routine
|
2019-10-25 01:30:30 +02:00
|
|
|
!call routine_bis
|
|
|
|
|
call print_grad
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
subroutine print_grad
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-10-22 18:56:26 +02:00
|
|
|
end
|
|
|
|
|
|
|
|
|
|
subroutine routine_bis
|
|
|
|
|
implicit none
|
|
|
|
|
integer :: i,j
|
|
|
|
|
double precision :: accu_d,accu_od
|
2019-10-23 00:11:55 +02:00
|
|
|
!accu_d = 0.d0
|
|
|
|
|
!accu_od = 0.d0
|
|
|
|
|
!print*,''
|
|
|
|
|
!print*,''
|
|
|
|
|
!print*,''
|
|
|
|
|
!do i = 1, mo_num
|
2019-10-22 20:22:54 +02:00
|
|
|
! write(*,'(100(F8.5,X))')super_ci_dm(i,:)
|
2019-10-23 00:11:55 +02:00
|
|
|
! accu_d += super_ci_dm(i,i)
|
|
|
|
|
! do j = i+1, mo_num
|
|
|
|
|
! accu_od += dabs(super_ci_dm(i,j) - super_ci_dm(j,i))
|
|
|
|
|
! enddo
|
|
|
|
|
!enddo
|
|
|
|
|
!print*,''
|
|
|
|
|
!print*,''
|
|
|
|
|
!print*,'accu_d = ',accu_d
|
|
|
|
|
!print*,'n_elec = ',elec_num
|
|
|
|
|
!print*,'accu_od= ',accu_od
|
|
|
|
|
!print*,''
|
|
|
|
|
!accu_d = 0.d0
|
|
|
|
|
!do i = 1, N_det
|
|
|
|
|
! accu_d += psi_coef(i,1)**2
|
|
|
|
|
!enddo
|
|
|
|
|
!print*,'accu_d = ',accu_d
|
|
|
|
|
!provide superci_natorb
|
|
|
|
|
|
|
|
|
|
provide switch_mo_coef
|
|
|
|
|
mo_coef = switch_mo_coef
|
|
|
|
|
call save_mos
|
2019-06-28 20:45:07 +02:00
|
|
|
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-07-01 18:30:23 +02:00
|
|
|
accu(1) += state_av_act_two_rdm_spin_trace_mo(ii,jj,kk,ll) * integral
|
2019-06-28 16:51:16 +02:00
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
2019-06-28 20:45:07 +02:00
|
|
|
print*,'accu = ',accu(1)
|
2019-07-04 16:16:57 +02:00
|
|
|
|
|
|
|
|
accu = 0.d0
|
|
|
|
|
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)
|
|
|
|
|
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
|
|
|
|
accu(1) += state_av_act_two_rdm_openmp_spin_trace_mo(ii,jj,kk,ll) * integral
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
print*,'accu = ',accu(1)
|
|
|
|
|
print*,'psi_energy_two_e = ',psi_energy_two_e
|
|
|
|
|
|
2019-07-05 18:50:22 +02:00
|
|
|
print *, psi_energy_with_nucl_rep
|
2019-06-28 16:51:16 +02:00
|
|
|
end
|
