diff --git a/devel/svdwf/H_svd.irp.f b/devel/svdwf/H_svd.irp.f new file mode 100644 index 0000000..aca53d6 --- /dev/null +++ b/devel/svdwf/H_svd.irp.f @@ -0,0 +1,142 @@ +program H_svd + implicit none + BEGIN_DOC + ! print the matrix H after SVD + ! pour debug : ./configure -c config/gfortran_debug.cfg + ! pour calcul : ./configure -c config/gfortran_avx.cfg + END_DOC + + read_wf = .True. + TOUCH read_wf + + PROVIDE N_int + + call run() +end + + + +subroutine run + implicit none + + integer(bit_kind) :: det1(N_int,2) + integer(bit_kind) :: det2(N_int,2) + + integer :: i, j, k, l, m, n, ii + integer :: degree + double precision :: x, h12, y + + integer :: n_svd + double precision, allocatable :: H(:,:), S(:,:), U_svd(:,:,:), V_svd(:,:,:) + + call ezfio_get_spindeterminants_n_svd_coefs(n_svd) + allocate(U_svd(n_det_alpha_unique,n_svd,1), V_svd(n_det_beta_unique,n_svd,1) ) + call ezfio_get_spindeterminants_psi_svd_alpha(U_svd) + call ezfio_get_spindeterminants_psi_svd_beta(V_svd) + ! !!! + allocate( H(n_svd,n_svd) , S(n_svd,n_svd) ) + H = 0.d0 + S = 0.d0 + ! !!! + do i = 1, n_det_alpha_unique + ! @@@ + do ii = 1, N_int + det1(ii,1) = psi_det_alpha_unique(ii,i) + enddo + ! @@@ + do k = 1, n_det_alpha_unique + ! @@@ + do ii = 1, N_int + det2(ii,1) = psi_det_alpha_unique(ii,k) + enddo + ! @@@ + ! !!! + ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + call get_excitation_degree_spin(det1(1,1),det2(1,1),degree,N_int) + if (degree .gt. 2) then + cycle + endif + ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + ! !!! + do j = 1, n_det_beta_unique + ! @@@ + do ii = 1, N_int + det1(ii,2) = psi_det_beta_unique(ii,j) + enddo + !call debug_det(det1,N_int) + !call debug_spindet(psi_det_beta_unique(1,j),N_int) + ! @@@ + do l = 1, n_det_beta_unique + ! @@@ + do ii = 1, N_int + det2(ii,2) = psi_det_beta_unique(ii,l) + enddo + ! @@@ + ! !!! + ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + call get_excitation_degree(det1,det2,degree,N_int) + if (degree .gt. 2) then + cycle + endif + ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + ! !!! + !call debug_det(det1,N_int) + !call debug_det(det2,N_int) + ! !!! + call i_H_j(det1, det2, N_int, h12) + !if( dabs(h12) .ge. 1.d-15 ) then + ! print *, i, j, k, l, h12 + !endif + ! !!! + do n=1, n_svd + x = U_svd(k,n,1) * V_svd(l,n,1) * h12 + do m=1, n_svd + H(m,n) += U_svd(i,m,1) * V_svd(j,m,1) * x + enddo + enddo + ! !!! + enddo + enddo + ! !!! + enddo + enddo + ! !!! + + + ! !!! + !do i = 1, n_det_alpha_unique + ! det1(:,1) = psi_det_alpha_unique(:,i) + ! do k = 1, n_det_alpha_unique + ! det2(:,1) = psi_det_alpha_unique(:,k) + ! !!! + ! do j = 1, n_det_beta_unique + ! det1(:,2) = psi_det_beta_unique(:,j) + ! do l = 1, n_det_beta_unique + ! det2(:,2) = psi_det_beta_unique(:,l) + ! !!! + ! do n = 1, 1 + ! y = U_svd(k,n,1) * V_svd(l,n,1) + ! do m = 1, n_svd + ! S(m,n) += U_svd(i,m,1) * V_svd(j,m,1) * y + ! enddo + ! enddo + ! !!! + ! enddo + ! enddo + ! !!! + ! enddo + !enddo + ! !!! + + deallocate( U_svd , V_svd ) + + do n=1, n_svd + do m=1, n_svd + print *, m, n, H(m,n), S(m,n) + enddo + enddo + + deallocate( H, S ) + +end +