save l/r coef after diag

src/tc_bi_ortho/psi_r_l_prov.irp.f

@@ -192,21 +192,16 @@ subroutine save_tc_wavefunction_general(ndet, nstates, psidet, sze, dim_psicoef,
   endif
 end
 
-subroutine save_tc_bi_ortho_wavefunction
+subroutine save_tc_bi_ortho_wavefunction()
   implicit none
   if(save_sorted_tc_wf)then
-  call save_tc_wavefunction_general( N_det, N_states, psi_det_sorted_tc, N_det &
+    call save_tc_wavefunction_general( N_det, N_states, psi_det_sorted_tc, size(psi_det_sorted_tc, 3) &
-                                   , size(psi_l_coef_sorted_bi_ortho, 1), psi_l_coef_sorted_bi_ortho &
+                                     , size(psi_l_coef_sorted_bi_ortho, 1), psi_l_coef_sorted_bi_ortho, psi_r_coef_sorted_bi_ortho)
-                                   , psi_r_coef_sorted_bi_ortho )
-  !call save_tc_wavefunction_general( N_det, N_states, psi_det_sorted_tc, size(psi_det_sorted_tc, 3) &
-  !                                 , size(psi_l_coef_sorted_bi_ortho, 1), psi_l_coef_sorted_bi_ortho &
-  !                                 , psi_r_coef_sorted_bi_ortho )
   else
     call save_tc_wavefunction_general( N_det, N_states, psi_det, size(psi_det, 3) &
-                                   , size(psi_l_coef_bi_ortho, 1), psi_l_coef_bi_ortho &
+                                     , size(psi_l_coef_bi_ortho, 1), psi_l_coef_bi_ortho, psi_r_coef_bi_ortho )
-                                   , psi_r_coef_bi_ortho )
   endif
- call routine_save_right_bi_ortho
+  call routine_save_right_bi_ortho()
 end
 
 subroutine routine_save_right_bi_ortho

src/tc_bi_ortho/tc_bi_ortho.irp.f

@@ -39,7 +39,7 @@ end
 subroutine routine_diag()
 
   implicit none
-  integer          :: i, j
+  integer          :: i, j, k
   double precision :: dE
 
   ! provide eigval_right_tc_bi_orth
@@ -82,6 +82,26 @@ subroutine routine_diag()
 
   endif
 
+  double precision, allocatable :: buffer(:,:)
+  allocate(buffer(N_det,N_states))
+  do k = 1, N_states
+    do i = 1, N_det
+      psi_l_coef_bi_ortho(i,k) = leigvec_tc_bi_orth(i,k)
+      buffer(i,k) = leigvec_tc_bi_orth(i,k)
+    enddo
+  enddo
+  TOUCH psi_l_coef_bi_ortho
+  call ezfio_set_tc_bi_ortho_psi_l_coef_bi_ortho(buffer)
+  do k = 1, N_states
+    do i = 1, N_det
+      psi_r_coef_bi_ortho(i,k) = reigvec_tc_bi_orth(i,k)
+      buffer(i,k) = reigvec_tc_bi_orth(i,k)
+    enddo
+  enddo
+  TOUCH psi_r_coef_bi_ortho
+  call ezfio_set_tc_bi_ortho_psi_r_coef_bi_ortho(buffer)
+  deallocate(buffer)
+
 end
 
 

src/tc_bi_ortho/tc_h_eigvectors.irp.f

@@ -59,8 +59,10 @@ end
   PROVIDE N_det N_int
 
   if(n_det .le. N_det_max_full) then
+
     allocate(reigvec_tc_bi_orth_tmp(N_det,N_det),leigvec_tc_bi_orth_tmp(N_det,N_det),eigval_right_tmp(N_det),expect_e(N_det))
     allocate (H_prime(N_det,N_det),s2_values_tmp(N_det))
+
     H_prime(1:N_det,1:N_det) = htilde_matrix_elmt_bi_ortho(1:N_det,1:N_det)
     if(s2_eig) then
       H_prime(1:N_det,1:N_det) += alpha * S2_matrix_all_dets(1:N_det,1:N_det)
@@ -68,17 +70,19 @@ end
         H_prime(j,j) = H_prime(j,j) - alpha*expected_s2
       enddo
     endif
-    call non_hrmt_real_diag(N_det,H_prime,& 
+
-         leigvec_tc_bi_orth_tmp,reigvec_tc_bi_orth_tmp,& 
+    call non_hrmt_real_diag(N_det, H_prime, leigvec_tc_bi_orth_tmp, reigvec_tc_bi_orth_tmp, n_real_tc_bi_orth_eigval_right, eigval_right_tmp)
-         n_real_tc_bi_orth_eigval_right,eigval_right_tmp)
 !    do i = 1, N_det
 !     call get_H_tc_s2_l0_r0(leigvec_tc_bi_orth_tmp(1,i),reigvec_tc_bi_orth_tmp(1,i),1,N_det,expect_e(i), s2_values_tmp(i))
 !    enddo
     call get_H_tc_s2_l0_r0(leigvec_tc_bi_orth_tmp,reigvec_tc_bi_orth_tmp,N_det,N_det,expect_e, s2_values_tmp)
+
     allocate(index_good_state_array(N_det),good_state_array(N_det))
     i_state = 0
     good_state_array = .False.
+
     if(s2_eig) then
+
       if(only_expected_s2) then
         do j = 1, N_det
          ! Select at least n_states states with S^2 values closed to "expected_s2"
@@ -98,6 +102,7 @@ end
           good_state_array(j) = .True.
         enddo
       endif
+
       if(i_state .ne. 0) then
         ! Fill the first "i_state" states that have a correct S^2 value
         do j = 1, i_state
@@ -146,6 +151,7 @@ end
       endif ! istate .ne. 0
 
     else ! s2_eig
+
       allocate(coef_hf_r(N_det),coef_hf_l(N_det),iorder(N_det))
       do i = 1,N_det
         iorder(i) = i
@@ -171,6 +177,7 @@ end
         print *,'State with largest LEFT  coefficient of HF ',igood_l
         print *,'coef of HF in LEFT  eigenvector = ',leigvec_tc_bi_orth_tmp(index_HF_psi_det,igood_l)
       endif
+
       if(state_following_tc) then
         print *,'Following the states with the largest coef on HF'
         print *,'igood_r,igood_l',igood_r,igood_l
@@ -178,7 +185,6 @@ end
         eigval_right_tc_bi_orth(1) = eigval_right_tmp(i)
         do j = 1, N_det
           reigvec_tc_bi_orth(j,1) = reigvec_tc_bi_orth_tmp(j,i)
-!          print*,reigvec_tc_bi_orth(j,1)
         enddo
         i = igood_l
         eigval_left_tc_bi_orth(1)  = eigval_right_tmp(i)
@@ -196,20 +202,9 @@ end
         enddo
       endif
 
-      ! check bi-orthogonality
-      allocate(Stmp(N_states,N_states))
-      call dgemm( 'T', 'N', N_states, N_states, N_det, 1.d0                                                              &
-            , leigvec_tc_bi_orth(1,1), size(leigvec_tc_bi_orth, 1), reigvec_tc_bi_orth(1,1), size(reigvec_tc_bi_orth, 1) &
-            , 0.d0, Stmp(1,1), size(Stmp, 1) )
-      print *, ' overlap matrix between states:'
-      do i = 1, N_states
-        write(*,'(1000(F16.10,X))') Stmp(i,:)
-      enddo
-      deallocate(Stmp)
-
     endif
 
-  else 
+  else ! n_det > N_det_max_full
 
     double precision, allocatable :: H_jj(:),vec_tmp(:,:)
     external                         htc_bi_ortho_calc_tdav
@@ -218,16 +213,19 @@ end
     external                         H_tc_dagger_u_0_opt
     external                         H_tc_s2_dagger_u_0_opt
     external                         H_tc_s2_u_0_opt
+
     allocate(H_jj(N_det),vec_tmp(N_det,n_states_diag))
+
     do i = 1, N_det
       call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
     enddo
- !!!! Preparing the left-eigenvector
+
     print*,'---------------------------------'
     print*,'---------------------------------'
     print*,'Computing the left-eigenvector '
     print*,'---------------------------------'
     print*,'---------------------------------'
+    !!!! Preparing the left-eigenvector
     vec_tmp = 0.d0
     do istate = 1, N_states
       vec_tmp(1:N_det,istate) = psi_l_coef_bi_ortho(1:N_det,istate)
@@ -280,6 +278,17 @@ end
   endif
 
   call bi_normalize(leigvec_tc_bi_orth, reigvec_tc_bi_orth, size(reigvec_tc_bi_orth, 1), N_det, N_states)
+  ! check bi-orthogonality
+  allocate(Stmp(N_states,N_states))
+  call dgemm( 'T', 'N', N_states, N_states, N_det, 1.d0                                                              &
+        , leigvec_tc_bi_orth(1,1), size(leigvec_tc_bi_orth, 1), reigvec_tc_bi_orth(1,1), size(reigvec_tc_bi_orth, 1) &
+        , 0.d0, Stmp(1,1), size(Stmp, 1) )
+  print *, ' overlap matrix between states:'
+  do i = 1, N_states
+    write(*,'(1000(F16.10,X))') Stmp(i,:)
+  enddo
+  deallocate(Stmp)
+
   print*,'leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1) = ', leigvec_tc_bi_orth(1,1), reigvec_tc_bi_orth(1,1)
   do i = 1, N_states
     norm_ground_left_right_bi_orth = 0.d0
@@ -291,27 +300,6 @@ end
     print*,' <S2>     = ', s2_eigvec_tc_bi_orth(i)
   enddo
 
-  ! ---
-
-  double precision, allocatable :: buffer(:,:)
-  allocate(buffer(N_det,N_states))
-
-  do k = 1, N_states
-    do i = 1, N_det
-      buffer(i,k) = leigvec_tc_bi_orth(i,k)
-    enddo
-  enddo
-  call ezfio_set_tc_bi_ortho_psi_l_coef_bi_ortho(buffer)
-
-  do k = 1, N_states
-    do i = 1, N_det
-      buffer(i,k) = reigvec_tc_bi_orth(i,k)
-    enddo
-  enddo
-  call ezfio_set_tc_bi_ortho_psi_r_coef_bi_ortho(buffer)
-
-  deallocate(buffer)
-
 END_PROVIDER 
 
 

src/tc_bi_ortho/tc_utils.irp.f

@@ -14,11 +14,13 @@ subroutine write_tc_energy()
         !htot = htilde_matrix_elmt_bi_ortho(i,j)
         call htilde_mu_mat_bi_ortho(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
         E_TC = E_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
+        !E_TC = E_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(j,k) * htot
       enddo
     enddo
 
     O_TC = 0.d0
     do i = 1, N_det
+      !O_TC = O_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(i,k)
       O_TC = O_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(i,k)
     enddo