10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-14 10:03:51 +01:00
quantum_package/plugins/MRPT/print_1h2p.irp.f

52 lines
973 B
Fortran
Raw Normal View History

program print_1h2p
implicit none
read_wf = .True.
touch read_wf
2017-02-06 21:28:01 +01:00
call routine
2016-11-17 17:03:48 +01:00
end
2017-03-16 21:21:27 +01:00
subroutine routine
implicit none
2017-04-20 08:48:06 +02:00
double precision,allocatable :: matrix_1h2p(:,:,:)
allocate (matrix_1h2p(N_det,N_det,N_states))
integer :: i,j,istate
do i = 1, N_det
do j = 1, N_det
do istate = 1, N_states
matrix_1h2p(i,j,istate) = 0.d0
enddo
enddo
2017-02-03 11:51:22 +01:00
enddo
2017-04-20 08:48:06 +02:00
if(.False.)then
call give_1h2p_contrib(matrix_1h2p)
double precision :: accu
accu = 0.d0
do i = 1, N_det
do j = 1, N_det
accu += matrix_1h2p(i,j,1) * psi_coef(i,1) * psi_coef(j,1)
2017-02-03 11:51:22 +01:00
enddo
2016-11-17 17:03:48 +01:00
enddo
2017-04-20 08:48:06 +02:00
print*, 'second order ', accu
endif
2016-11-17 17:03:48 +01:00
2017-04-20 08:48:06 +02:00
if(.True.)then
do i = 1, N_det
do j = 1, N_det
do istate = 1, N_states
matrix_1h2p(i,j,istate) = 0.d0
enddo
enddo
enddo
2017-04-20 08:48:06 +02:00
call give_1h2p_new(matrix_1h2p)
accu = 0.d0
do i = 1, N_det
do j = 1, N_det
accu += matrix_1h2p(i,j,1) * psi_coef(i,1) * psi_coef(j,1)
enddo
enddo
endif
print*, 'third order ', accu
deallocate (matrix_1h2p)
end