mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-12-22 04:13:40 +01:00
Added svdwf module
This commit is contained in:
parent
04c75ab70c
commit
16d5b14f36
@ -96,7 +96,7 @@ subroutine get_fock_matrix_alpha(det,F)
|
||||
|
||||
integer :: i,j,k
|
||||
|
||||
F(:,:) = fock_op_cshell_ref_bitmask(:,:)
|
||||
F(:,:) = fock_operator_closed_shell_ref_bitmask(:,:)
|
||||
|
||||
end
|
||||
|
||||
@ -112,7 +112,7 @@ subroutine get_fock_matrix_beta(det,F)
|
||||
|
||||
integer :: i,j,k
|
||||
|
||||
F(:,:) = fock_op_cshell_ref_bitmask(:,:)
|
||||
F(:,:) = fock_operator_closed_shell_ref_bitmask(:,:)
|
||||
|
||||
end
|
||||
|
||||
|
||||
59
devel/svdwf/.gitignore
vendored
Normal file
59
devel/svdwf/.gitignore
vendored
Normal file
@ -0,0 +1,59 @@
|
||||
IRPF90_temp/
|
||||
IRPF90_man/
|
||||
build.ninja
|
||||
irpf90.make
|
||||
ezfio_interface.irp.f
|
||||
irpf90_entities
|
||||
tags
|
||||
Makefile
|
||||
ao_basis
|
||||
ao_one_e_ints
|
||||
ao_two_e_erf_ints
|
||||
ao_two_e_ints
|
||||
aux_quantities
|
||||
becke_numerical_grid
|
||||
bitmask
|
||||
cis
|
||||
cisd
|
||||
cipsi
|
||||
davidson
|
||||
davidson_dressed
|
||||
davidson_undressed
|
||||
density_for_dft
|
||||
determinants
|
||||
dft_keywords
|
||||
dft_utils_in_r
|
||||
dft_utils_one_e
|
||||
dft_utils_two_body
|
||||
dressing
|
||||
dummy
|
||||
electrons
|
||||
ezfio_files
|
||||
fci
|
||||
generators_cas
|
||||
generators_full
|
||||
hartree_fock
|
||||
iterations
|
||||
kohn_sham
|
||||
kohn_sham_rs
|
||||
mo_basis
|
||||
mo_guess
|
||||
mo_one_e_ints
|
||||
mo_two_e_erf_ints
|
||||
mo_two_e_ints
|
||||
mpi
|
||||
mrpt_utils
|
||||
nuclei
|
||||
perturbation
|
||||
pseudo
|
||||
psiref_cas
|
||||
psiref_utils
|
||||
scf_utils
|
||||
selectors_cassd
|
||||
selectors_full
|
||||
selectors_utils
|
||||
single_ref_method
|
||||
slave
|
||||
tools
|
||||
utils
|
||||
zmq
|
||||
1
devel/svdwf/NEED
Normal file
1
devel/svdwf/NEED
Normal file
@ -0,0 +1 @@
|
||||
determinants
|
||||
4
devel/svdwf/README.rst
Normal file
4
devel/svdwf/README.rst
Normal file
@ -0,0 +1,4 @@
|
||||
=====
|
||||
svdwf
|
||||
=====
|
||||
|
||||
101
devel/svdwf/random_svd.irp.f
Normal file
101
devel/svdwf/random_svd.irp.f
Normal file
@ -0,0 +1,101 @@
|
||||
program svdwf
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Make the SVD of the alpha-beta wave function and print singular values.
|
||||
END_DOC
|
||||
read_wf = .True.
|
||||
TOUCH read_wf
|
||||
call run()
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
include 'constants.include.F'
|
||||
double precision, allocatable :: U(:,:), V(:,:), D(:), A(:,:)
|
||||
integer :: i, j, k, l, q, r, m, n, iter
|
||||
double precision,allocatable :: Z(:,:), P(:,:), Yt(:,:), UYt(:,:)
|
||||
double precision :: r1,r2
|
||||
|
||||
m = n_det_alpha_unique
|
||||
n = n_det_beta_unique
|
||||
|
||||
r = min(1000,n)
|
||||
|
||||
allocate(Z(m,r))
|
||||
|
||||
! Z(m,r) = A(m,n).P(n,r)
|
||||
Z(:,:) = 0.d0
|
||||
do l=1,r
|
||||
do k=1,N_det
|
||||
i = psi_bilinear_matrix_rows(k)
|
||||
j = psi_bilinear_matrix_columns(k)
|
||||
call random_number(r1)
|
||||
call random_number(r2)
|
||||
r1 = dsqrt(-2.d0*dlog(r1))
|
||||
r2 = dtwo_pi*r2
|
||||
Z(i,l) = Z(i,l) + psi_bilinear_matrix_values(k,1) * r1*dcos(r2)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Power iterations
|
||||
allocate(P(n,r))
|
||||
do iter=1,20
|
||||
! P(n,r) = At(n,m).Z(m,r)
|
||||
P(:,:) = 0.d0
|
||||
do l=1,r
|
||||
do k=1,N_det
|
||||
i = psi_bilinear_matrix_rows(k)
|
||||
j = psi_bilinear_matrix_columns(k)
|
||||
P(j,l) = P(j,l) + psi_bilinear_matrix_values(k,1) * Z(i,l)
|
||||
enddo
|
||||
enddo
|
||||
Z(:,:) = 0.d0
|
||||
do l=1,r
|
||||
do k=1,N_det
|
||||
i = psi_bilinear_matrix_rows(k)
|
||||
j = psi_bilinear_matrix_columns(k)
|
||||
Z(i,l) = Z(i,l) + psi_bilinear_matrix_values(k,1) * P(j,l)
|
||||
enddo
|
||||
enddo
|
||||
! Compute QR
|
||||
call ortho_qr(Z,size(Z,1),m,r)
|
||||
enddo
|
||||
|
||||
! Y(r,n) = Zt(r,m).A(m,n)
|
||||
allocate(Yt(n,r))
|
||||
Yt(:,:) = 0.d0
|
||||
do l=1,r
|
||||
do k=1,N_det
|
||||
i = psi_bilinear_matrix_rows(k)
|
||||
j = psi_bilinear_matrix_columns(k)
|
||||
Yt(j,l) = Yt(j,l) + Z(i,l) * psi_bilinear_matrix_values(k,1)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
allocate(D(r),V(n,r), UYt(r,r))
|
||||
call svd(Yt,size(Yt,1),V,size(V,1),D,UYt,size(UYt,1),n,r)
|
||||
deallocate(Yt)
|
||||
|
||||
! U(m,r) = Z(m,r).UY(r,r)
|
||||
allocate(U(m,r))
|
||||
call dgemm('N','T',m,r,r,1.d0,Z,size(Z,1),UYt,size(UYt,1),0.d0,U,size(U,1))
|
||||
deallocate(UYt,Z)
|
||||
|
||||
do i=1,r
|
||||
print *, i, real(D(i)), real(D(i)**2), real(sum(D(1:i)**2))
|
||||
if (D(i) < 1.d-15) then
|
||||
k = i
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
print *, 'threshold: ', 2.858 * D(k/2)
|
||||
do i=1,m
|
||||
print '(I6,4(X,F12.8))', i, U(i,1:4)
|
||||
enddo
|
||||
print *, ''
|
||||
do i=1,n
|
||||
print '(I6,4(X,F12.8))', i, V(i,1:4)
|
||||
enddo
|
||||
|
||||
deallocate(U,D,V)
|
||||
end
|
||||
47
devel/svdwf/svdwf.irp.f
Normal file
47
devel/svdwf/svdwf.irp.f
Normal file
@ -0,0 +1,47 @@
|
||||
program svdwf
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! TODO : Make the SVD of the alpha-beta wave function and print singular values.
|
||||
END_DOC
|
||||
read_wf = .True.
|
||||
TOUCH read_wf
|
||||
call run()
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
double precision, allocatable :: U(:,:), Vt(:,:), D(:), A(:,:)
|
||||
integer :: i, j, k, p, q
|
||||
|
||||
allocate( A (n_det_alpha_unique, n_det_beta_unique), &
|
||||
U (n_det_alpha_unique, n_det_alpha_unique), &
|
||||
Vt(n_det_beta_unique, n_det_beta_unique), &
|
||||
D(max(n_det_beta_unique,n_det_alpha_unique)) )
|
||||
|
||||
A = 0.D0
|
||||
do k=1,N_det
|
||||
i = psi_bilinear_matrix_rows(k)
|
||||
j = psi_bilinear_matrix_columns(k)
|
||||
A(i,j) = psi_bilinear_matrix_values(k,1)
|
||||
enddo
|
||||
|
||||
call randomized_svd(A, size(A,1), &
|
||||
U, size(U,1), D, Vt, size(Vt,1), n_det_alpha_unique, n_det_beta_unique, &
|
||||
6,1000)
|
||||
|
||||
do i=1,n_det_beta_unique
|
||||
print *, i, real(D(i)), real(D(i)**2), real(sum(D(1:i)**2))
|
||||
if (D(i) < 1.d-15) then
|
||||
k = i
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
print *, 'threshold: ', 2.858 * D(k/2)
|
||||
do i=1,n_det_alpha_unique
|
||||
print '(I6,4(X,F12.8))', i, U(i,1:4)
|
||||
enddo
|
||||
print *, ''
|
||||
do i=1,n_det_beta_unique
|
||||
print '(I6,4(X,F12.8))', i, Vt(1:4,i)
|
||||
enddo
|
||||
end
|
||||
Loading…
Reference in New Issue
Block a user