mirror of
https://github.com/LCPQ/quantum_package
synced 2024-11-04 21:24:02 +01:00
55 lines
1.3 KiB
Fortran
55 lines
1.3 KiB
Fortran
program mrcc_sto
|
|
implicit none
|
|
BEGIN_DOC
|
|
! TODO
|
|
END_DOC
|
|
print *, "========================"
|
|
print *, "========================"
|
|
print *, "========================"
|
|
print *, "MRCC_STO not implemented - acts as a unittest for dress_zmq"
|
|
print *, "========================"
|
|
print *, "========================"
|
|
print *, "========================"
|
|
call dress_zmq()
|
|
end
|
|
|
|
|
|
|
|
!! TESTS MINILIST
|
|
subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha)
|
|
use bitmasks
|
|
implicit none
|
|
double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2)
|
|
integer, intent(in) :: n_minilist
|
|
integer(bit_kind),intent(in) :: alpha(N_int, 2)
|
|
integer, intent(in) :: minilist(n_minilist)
|
|
integer :: a, i, deg
|
|
integer :: refc(N_det), testc(N_det)
|
|
|
|
refc = 0
|
|
testc = 0
|
|
do i=1,N_det
|
|
call get_excitation_degree(psi_det_sorted(1,1,i), alpha, deg, N_int)
|
|
if(deg <= 2) refc(i) = refc(i) + 1
|
|
end do
|
|
do i=1,n_minilist
|
|
call get_excitation_degree(psi_det_sorted(1,1,minilist(i)), alpha, deg, N_int)
|
|
if(deg <= 2) then
|
|
testc(minilist(i)) += 1
|
|
else
|
|
stop "NON LINKED IN MINILIST"
|
|
end if
|
|
end do
|
|
|
|
do i=1,N_det
|
|
if(refc(i) /= testc(i)) then
|
|
print *, "MINILIST FAIL ", sum(refc), sum(testc), n_minilist
|
|
exit
|
|
end if
|
|
end do
|
|
|
|
delta_ij_loc = 0d0
|
|
end subroutine
|
|
|
|
|