evaluate the matrix < U_k V_k| H | U_l V_l> after SVD C = U sigma V

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
+