1
0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-06-02 03:15:25 +02:00

Added entropy

This commit is contained in:
Anthony Scemama 2020-12-23 00:29:55 +01:00
parent c34324368e
commit eed703afa9
2 changed files with 11 additions and 14 deletions

View File

@ -12,6 +12,7 @@ subroutine run
implicit none implicit none
double precision, allocatable :: U(:,:), Vt(:,:), D(:), A(:,:) double precision, allocatable :: U(:,:), Vt(:,:), D(:), A(:,:)
integer :: i, j, k, p, q integer :: i, j, k, p, q
double precision :: entropy
allocate( A (n_det_alpha_unique, n_det_beta_unique), & allocate( A (n_det_alpha_unique, n_det_beta_unique), &
U (n_det_alpha_unique, n_det_alpha_unique), & U (n_det_alpha_unique, n_det_alpha_unique), &
@ -29,19 +30,22 @@ subroutine run
U, size(U,1), D, Vt, size(Vt,1), n_det_alpha_unique, n_det_beta_unique, & U, size(U,1), D, Vt, size(Vt,1), n_det_alpha_unique, n_det_beta_unique, &
6,1000) 6,1000)
entropy = 0.d0
do i=1,n_det_beta_unique do i=1,n_det_beta_unique
print *, i, real(D(i)), real(D(i)**2), real(sum(D(1:i)**2)) print *, i, real(D(i)), real(D(i)**2), real(sum(D(1:i)**2))
entropy -= D(i) * dlog(D(i))
if (D(i) < 1.d-15) then if (D(i) < 1.d-15) then
k = i k = i
exit exit
endif endif
enddo enddo
print *, 'threshold: ', 2.858 * D(k/2) print *, 'threshold: ', 2.858 * D(k/2)
do i=1,n_det_alpha_unique print *, 'Entropy : ', entropy
print '(I6,4(X,F12.8))', i, U(i,1:4) ! do i=1,n_det_alpha_unique
enddo ! print '(I6,4(X,F12.8))', i, U(i,1:4)
print *, '' ! enddo
do i=1,n_det_beta_unique ! print *, ''
print '(I6,4(X,F12.8))', i, Vt(1:4,i) ! do i=1,n_det_beta_unique
enddo ! print '(I6,4(X,F12.8))', i, Vt(1:4,i)
! enddo
end end

View File

@ -1,7 +0,0 @@
[t1_amplitudes]
type: double precision
doc: Amplitudes for the single-excitation operator
interface: ezfio,provider
size: (mo_basis.mo_num,mo_basis.mo_num)