LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

Improved print_energy

Browse Source
This commit is contained in:
Anthony Scemama 2021-03-26 01:04:23 +01:00
parent d217a6b9f1
commit 882d8ee350
2 changed files with 57 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
src/cipsi/selection.irp.f
View File

@ -8,27 +8,56 @@ subroutine get_mask_phase(det1, pm, Nint)
integer(bit_kind), intent(out) :: pm(Nint,2) integer(bit_kind), intent(out) :: pm(Nint,2)
integer(bit_kind) :: tmp1, tmp2 integer(bit_kind) :: tmp1, tmp2
integer :: i integer :: i
pm(1:Nint,1:2) = det1(1:Nint,1:2)
tmp1 = 0_8 tmp1 = 0_8
tmp2 = 0_8 tmp2 = 0_8
do i=1,Nint select case (Nint)
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 1))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 1)) BEGIN_TEMPLATE
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2)) case ($Nint)
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2)) do i=1,$Nint
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4)) pm(i,1) = ieor(det1(i,1), shiftl(det1(i,1), 1))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4)) pm(i,2) = ieor(det1(i,2), shiftl(det1(i,2), 1))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8)) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8)) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16)) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16)) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32)) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32)) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
pm(i,1) = ieor(pm(i,1), tmp1) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
pm(i,2) = ieor(pm(i,2), tmp2) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
end do pm(i,1) = ieor(pm(i,1), tmp1)
pm(i,2) = ieor(pm(i,2), tmp2)
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
end do
SUBST [ Nint ]
1;;
2;;
3;;
4;;
END_TEMPLATE
case default
do i=1,Nint
pm(i,1) = ieor(det1(i,1), shiftl(det1(i,1), 1))
pm(i,2) = ieor(det1(i,2), shiftl(det1(i,2), 1))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
pm(i,1) = ieor(pm(i,1), tmp1)
pm(i,2) = ieor(pm(i,2), tmp2)
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
end do
end select
end subroutine end subroutine
@ -445,11 +474,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
endif endif
do i=1,fullinteresting(0) do i=1,fullinteresting(0)
fullminilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,fullinteresting(i)) do k=1,N_int
fullminilist(k,1,i) = psi_det_sorted(k,1,fullinteresting(i))
fullminilist(k,2,i) = psi_det_sorted(k,2,fullinteresting(i))
enddo
enddo enddo
do i=1,interesting(0) do i=1,interesting(0)
minilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,interesting(i)) do k=1,N_int
minilist(k,1,i) = psi_det_sorted(k,1,interesting(i))
minilist(k,2,i) = psi_det_sorted(k,2,interesting(i))
enddo
enddo enddo
do s2=s1,2 do s2=s1,2

21
src/tools/print_energy.irp.f
View File

@ -14,24 +14,5 @@ end
subroutine run subroutine run
implicit none implicit none
integer :: i,j print *, psi_energy + nuclear_repulsion
double precision :: i_H_psi_array(N_states)
double precision :: E(N_states)
double precision :: norm(N_states)
E(1:N_states) = nuclear_repulsion
norm(1:N_states) = 0.d0
do i=1,N_det
call i_H_psi(psi_det(1,1,i), psi_det, psi_coef, N_int, N_det, &
size(psi_coef,1), N_states, i_H_psi_array)
do j=1,N_states
norm(j) += psi_coef(i,j)*psi_coef(i,j)
E(j) += i_H_psi_array(j) * psi_coef(i,j)
enddo
enddo
print *, 'Energy:'
do i=1,N_states
print *, E(i)/norm(i)
enddo
end end