fixed the bug of misalignement between coefs and determinants in fci_tc_bi_ortho

src/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f

@@ -134,7 +134,6 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
   PROVIDE psi_det_hii selection_weight pseudo_sym
   PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
   PROVIDE excitation_beta_max  excitation_alpha_max excitation_max
-  PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
 
   if (h0_type == 'CFG') then
     PROVIDE psi_configuration_hii det_to_configuration

src/cipsi_tc_bi_ortho/selection.irp.f

@@ -181,7 +181,6 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
   PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
   PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
   PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc
-  PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
 
   PROVIDE banned_excitation
 
@@ -616,7 +615,6 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
 
 
   PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc
-  PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
 
 
   mat   = 0d0
@@ -628,7 +626,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
     negMask(i,2) = not(mask(i,2))
   end do
 
-  print*,'in selection '
+!  print*,'in selection '
   do i = 1, N_sel
 !    call debug_det(det(1,1,i),N_int)
 !    print*,i,dabs(psi_selectors_coef_transp_tc(1,2,i) * psi_selectors_coef_transp_tc(1,1,i))
@@ -677,9 +675,6 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
           perMask(j,1) = iand(mask(j,1), not(det(j,1,i)))
           perMask(j,2) = iand(mask(j,2), not(det(j,2,i)))
         end do
-!        call get_d3_h  ( det(1,1,i), bannedOrb, banned, mat         , mask, p, sp, psi_selectors_coef_transp_tc (1, interesting(i)) )
-!        call get_d3_htc( det(1,1,i), bannedOrb, banned, mat_r, mat_l, mask, p, sp, psi_selectors_rcoef_bi_orth_transp(1, interesting(i)) &
-!                       , psi_selectors_lcoef_bi_orth_transp(1, interesting(i)) )
 
         call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int)
         call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int)
@@ -921,16 +916,27 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
           endif
           val = 4.d0 * psi_h_alpha * alpha_h_psi 
           tmp = dsqrt(delta_E * delta_E + val)
-          if (delta_E < 0.d0) then
+!          if (delta_E < 0.d0) then
-              tmp = -tmp
+!              tmp = -tmp
-          endif
+!          endif
-          e_pert(istate) = 0.5d0 * (tmp - delta_E)
+          e_pert(istate) = 0.25 * val / delta_E
+!          e_pert(istate) = 0.5d0 * (tmp - delta_E)
           if(dsqrt(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then
-           coef(istate)   = e_pert(istate) / alpha_h_psi
+           coef(istate)   = e_pert(istate) / psi_h_alpha 
           else
            coef(istate)   = alpha_h_psi / delta_E 
           endif
 
+          if(selection_tc == 1)then
+           if(e_pert(istate).lt.0.d0)then 
+            e_pert(istate)=0.d0
+           else 
+            e_pert(istate)=-e_pert(istate)
+           endif
+          else if(selection_tc == -1)then
+           if(e_pert(istate).gt.0.d0)e_pert(istate)=0.d0
+          endif
+          
 !         if(selection_tc     ==  1 )then
 !          if(e_pert(istate).lt.0.d0)then
 !           e_pert(istate) = 0.d0
@@ -943,7 +949,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
         enddo
 
 
-      do_diag = sum(dabs(coef)) > 0.001d0 .and. N_states > 1
 
       do istate = 1, N_states
 

src/cipsi_tc_bi_ortho/selection_buffer.irp.f

@@ -125,7 +125,11 @@ subroutine merge_selection_buffers(b1, b2)
   enddo
   b2%det => detmp
   b2%val => val
-  b2%mini = min(b2%mini,b2%val(b2%N))
+!  if(selection_tc == 1)then
+!   b2%mini = max(b2%mini,b2%val(b2%N))
+!  else
+   b2%mini = min(b2%mini,b2%val(b2%N))
+!  endif
   b2%cur = nmwen
 end
 
@@ -157,7 +161,11 @@ subroutine sort_selection_buffer(b)
   end do
   deallocate(b%det,iorder)
   b%det => detmp
-  b%mini = min(b%mini,b%val(b%N))
+!  if(selection_tc == 1)then
+!   b%mini = max(b%mini,b%val(b%N))
+!  else
+   b%mini = min(b%mini,b%val(b%N))
+!  endif
   b%cur = nmwen
 end subroutine
 

src/cipsi_tc_bi_ortho/slave_cipsi.irp.f

@@ -17,7 +17,6 @@ end
 
 subroutine provide_everything
   PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
-  PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
 
   PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context
   PROVIDE psi_det psi_coef threshold_generators state_average_weight
@@ -312,7 +311,6 @@ subroutine run_slave_main
           PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
           PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
           PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted_tc
-          PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
 
           PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks
 

src/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f

@@ -108,6 +108,7 @@ subroutine run_stochastic_cipsi
     ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm
     pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1))
     call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
+!    stop
     if (qp_stop()) exit
   enddo
 !  print*,'data to extrapolate '

src/fci_tc_bi/generators.irp.f

@@ -31,14 +31,6 @@ END_PROVIDER
  END_DOC
  psi_det_generators(1:N_int,1:2,1:N_det) = psi_det_sorted_tc(1:N_int,1:2,1:N_det)
  psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted_tc(1:N_det,1:N_states)
- integer :: i
-! print*,'generators '
- do i = 1, N_det
-      if(N_det.ne.1)then
-      print*,'writing generators'
-      write(33,*) psi_det_generators(1,1,i), psi_det_generators(1,2,i)
-      endif
- enddo
 
 END_PROVIDER
 

src/fci_tc_bi/selectors.irp.f

@@ -18,15 +18,6 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
   double precision               :: norm, norm_max
   call write_time(6)
   N_det_selectors = N_det
-!  norm = 1.d0
-!  do i=1,N_det
-!    norm = norm - psi_average_norm_contrib_tc(i)
-!    if (norm - 1.d-10 < 1.d0 - threshold_selectors) then
-!      N_det_selectors = i
-!      exit
-!    endif
-!  enddo
-  N_det_selectors = max(N_det_selectors,N_det_generators)
   call write_int(6,N_det_selectors,'Number of selectors')
 END_PROVIDER
 
@@ -43,27 +34,13 @@ END_PROVIDER
     do k=1,N_int
       psi_selectors(k,1,i) = psi_det_sorted_tc(k,1,i)
       psi_selectors(k,2,i) = psi_det_sorted_tc(k,2,i)
-!      psi_selectors(k,2,i) = psi_det(k,2,i)
-!      psi_selectors(k,2,i) = psi_det(k,2,i)
     enddo
   enddo
- print*,'selectors '
   do k=1,N_states
     do i=1,N_det_selectors
-      psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k)
+      psi_selectors_coef(i,k)      = psi_coef_sorted_tc_gen(i,k)
-!      psi_selectors_coef_tc(i,1,k) = psi_l_coef_bi_ortho(i,k)
-!      psi_selectors_coef_tc(i,2,k) = psi_r_coef_bi_ortho(i,k)
       psi_selectors_coef_tc(i,1,k) = psi_l_coef_sorted_bi_ortho(i,k)
       psi_selectors_coef_tc(i,2,k) = psi_r_coef_sorted_bi_ortho(i,k)
-!      call debug_det(psi_selectors(1,1,i),N_int)
-      if(N_det.ne.1)then
-       print*,'writing selectors'
-       write(34,*)psi_selectors(1,1,i),psi_selectors(1,2,i)
-       write(40,'(F10.7)')dabs(psi_selectors_coef_tc(i,1,1) * psi_selectors_coef_tc(i,2,1))
-      endif
-!      psi_selectors_coef_tc(i,1,k) = 1.d0
-!      psi_selectors_coef_tc(i,2,k) = 1.d0
-       
     enddo
   enddo
 
@@ -83,31 +60,9 @@ END_PROVIDER
       psi_selectors_coef_transp_tc(k,1,i) = psi_selectors_coef_tc(i,1,k)
       psi_selectors_coef_transp_tc(k,2,i) = psi_selectors_coef_tc(i,2,k)
     enddo
-    if(N_det.ne.1)then
-    write(41,'(F10.7)')dabs(psi_selectors_coef_transp_tc(1,1,i)*psi_selectors_coef_transp_tc(1,2,i))
-    endif
   enddo
 END_PROVIDER
 
- BEGIN_PROVIDER [ double precision, psi_selectors_rcoef_bi_orth_transp, (N_states, psi_det_size) ]
-&BEGIN_PROVIDER [ double precision, psi_selectors_lcoef_bi_orth_transp, (N_states, psi_det_size) ]
-
-  implicit none
-  integer :: i, k
-
-  psi_selectors_rcoef_bi_orth_transp = 0.d0
-  psi_selectors_lcoef_bi_orth_transp = 0.d0
-
-  print*,'N_det,N_det_selectors',N_det,N_det_selectors
-  do i = 1, N_det_selectors
-    do k = 1, N_states
-      psi_selectors_rcoef_bi_orth_transp(k,i) = psi_r_coef_sorted_bi_ortho(i,k)
-      psi_selectors_lcoef_bi_orth_transp(k,i) = psi_l_coef_sorted_bi_ortho(i,k)
-    enddo
-  enddo
-
-END_PROVIDER
-
 BEGIN_PROVIDER [ integer, psi_selectors_size ]
  implicit none
  psi_selectors_size = psi_det_size

src/tc_bi_ortho/psi_det_tc_sorted.irp.f

@@ -11,7 +11,7 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ]
   psi_average_norm_contrib_tc(:) = 0.d0
   do k=1,N_states
     do i=1,N_det
-      psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i) +    &
+      psi_average_norm_contrib_tc(i) = & 
           dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))*state_average_weight(k)
     enddo
   enddo
@@ -26,39 +26,54 @@ END_PROVIDER
 &BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc, (psi_det_size,N_states) ]
 &BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_tc, (psi_det_size) ]
 &BEGIN_PROVIDER [ integer, psi_det_sorted_tc_order, (psi_det_size) ]
+&BEGIN_PROVIDER [double precision, psi_r_coef_sorted_bi_ortho, (psi_det_size, N_states)]
+&BEGIN_PROVIDER [double precision, psi_l_coef_sorted_bi_ortho, (psi_det_size, N_states)]
    implicit none
    BEGIN_DOC
    ! Wave function sorted by determinants contribution to the norm (state-averaged)
    !
    ! psi_det_sorted_tc_order(i) -> k : index in psi_det
+   !
+   ! psi_r_coef_sorted_bi_ortho : right coefficients corresponding to psi_det_sorted_tc
+   !
+   ! psi_l_coef_sorted_bi_ortho : left  coefficients corresponding to psi_det_sorted_tc
    END_DOC
    integer                        :: i,j,k
    integer, allocatable           :: iorder(:)
-   print *, 'providing psi_det_sorted_tc'
    allocate ( iorder(N_det) )
-   print*,'before '
+!   print*,'before = '
    do i=1,N_det
-     psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
      iorder(i) = i
-     print*,i,iorder(i),psi_average_norm_contrib_sorted_tc(i)
+     psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
+!    print*,'------------'
+!     call debug_det(psi_det(1,1,i),N_int)
+!     print*,i,psi_average_norm_contrib_tc(i)
+!    print*,i,psi_l_coef_bi_ortho(iorder(i),1:N_states),psi_r_coef_bi_ortho(iorder(i),1:N_states)
+!    print*,'------------'
    enddo
    call dsort(psi_average_norm_contrib_sorted_tc,iorder,N_det)
-   print*,'after '
+!   print*,'after = '
    do i=1,N_det
-!     iorder(i) = i
+     psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
-     print*,i,iorder(i),psi_average_norm_contrib_sorted_tc(i)
      do j=1,N_int
        psi_det_sorted_tc(j,1,i) = psi_det(j,1,iorder(i))
        psi_det_sorted_tc(j,2,i) = psi_det(j,2,iorder(i))
      enddo
-    psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
+     psi_det_sorted_tc_order(iorder(i)) = i
-    psi_det_sorted_tc_order(iorder(i)) = i
+!     if(iorder(i).ne.i)then
+!      print*,'changed the order for ',i,iorder(i)
+!     endif
+!      print*,'------------'
+!      call debug_det(psi_det_sorted_tc(1,1,i),N_int)
+!      print*,i,psi_average_norm_contrib_tc(i)
+!      print*,i,psi_l_coef_bi_ortho(iorder(i),1:N_states),psi_r_coef_bi_ortho(iorder(i),1:N_states)
+!      print*,'------------'
    enddo
    double precision :: accu
    do k=1,N_states
     accu = 0.d0
     do i=1,N_det
-     psi_coef_sorted_tc(i,k) = dsqrt(dabs(psi_l_coef_bi_ortho(iorder(i),k)*psi_r_coef_bi_ortho(iorder(i),k)))
+     psi_coef_sorted_tc(i,k) = dsqrt(psi_average_norm_contrib_sorted_tc(i))
      accu += psi_coef_sorted_tc(i,k)**2
     enddo
     accu = 1.d0/dsqrt(accu)
@@ -72,60 +87,33 @@ END_PROVIDER
    psi_average_norm_contrib_sorted_tc(N_det+1:psi_det_size) = 0.d0
    psi_det_sorted_tc_order(N_det+1:psi_det_size) = 0
 
-   deallocate(iorder)
-  logical :: pouet
- pouet  = .true.
- do i = 1, N_det
-  if(psi_average_norm_contrib_sorted_tc(i) == 0.d0)then
-   pouet = .False.
-   exit
-  endif
- enddo
- 
- if(pouet.and.N_det.ne.1)then
- print*,'writing sorted'
- do i = 1, N_det
-!   call debug_det(psi_det_sorted_tc(1,1,i),N_int)
-   print*,i,psi_average_norm_contrib_sorted_tc(i)
-   write(35,*)psi_det_sorted_tc(1,1,i),psi_det_sorted_tc(1,2,i)
- enddo
- endif
-
-END_PROVIDER
-
- BEGIN_PROVIDER [double precision, psi_r_coef_sorted_bi_ortho, (psi_det_size, N_states)]
-&BEGIN_PROVIDER [double precision, psi_l_coef_sorted_bi_ortho, (psi_det_size, N_states)]
- BEGIN_DOC
- ! psi_r_coef_sorted_bi_ortho : right coefficients corresponding to psi_det_sorted_tc
- ! psi_l_coef_sorted_bi_ortho : left  coefficients corresponding to psi_det_sorted_tc
- END_DOC
-   implicit none
-   integer                       :: i, j, k
    psi_r_coef_sorted_bi_ortho = 0.d0
    psi_l_coef_sorted_bi_ortho = 0.d0
    do i = 1, N_det
-    psi_r_coef_sorted_bi_ortho(i,1) = psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1)
+    psi_r_coef_sorted_bi_ortho(i,1:N_states) = psi_r_coef_bi_ortho(iorder(i),1:N_states)
-    psi_l_coef_sorted_bi_ortho(i,1) = psi_l_coef_bi_ortho(psi_det_sorted_tc_order(i),1)
+    psi_l_coef_sorted_bi_ortho(i,1:N_states) = psi_l_coef_bi_ortho(iorder(i),1:N_states)
    enddo
-   logical :: pouet
+
-   pouet  = .true.
+   deallocate(iorder)
-   do i = 1, N_det
+!  logical :: pouet
-    if(psi_l_coef_sorted_bi_ortho(i,1) == 0.d0)then
+! pouet  = .true.
-     pouet = .False.
+! do i = 1, N_det
-     exit
+!  if(psi_average_norm_contrib_sorted_tc(i) == 0.d0)then
-    endif
+!   pouet = .False.
-   enddo
+!   exit
-   if(pouet.and.N_det.ne.1)then
+!  endif
-   print*,'psi_r_coef_sorted_bi_ortho'
+! enddo
-    do i = 1, N_det
+! 
-     print*,psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1)
+! if(pouet.and.N_det.ne.1)then
-     write(42,'(F10.7)')dabs(psi_r_coef_sorted_bi_ortho(i,1)*psi_l_coef_sorted_bi_ortho(i,1))
+! print*,'writing sorted'
-    enddo
+! do i = 1, N_det
-   endif
+!   print*,i,psi_average_norm_contrib_sorted_tc(i)
+!   write(35,*)psi_det_sorted_tc(1,1,i),psi_det_sorted_tc(1,2,i)
+! enddo
+! endif
 
 END_PROVIDER
 
-
  BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_bit, (N_int,2,psi_det_size) ]
 &BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc_bit, (psi_det_size,N_states) ]
    implicit none

src/tc_bi_ortho/psi_r_l_prov.irp.f

@@ -136,15 +136,15 @@ BEGIN_PROVIDER [ double precision, psi_r_coef_bi_ortho, (psi_det_size,N_states)
 END_PROVIDER
 
 
-subroutine save_tc_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psilcoef,psircoef)
+subroutine save_tc_wavefunction_general(ndet,nstates,psidet,sze,dim_psicoef,psilcoef,psircoef)
   implicit none
   BEGIN_DOC
   !  Save the wave function into the |EZFIO| file
   END_DOC
   use bitmasks
   include 'constants.include.F'
-  integer, intent(in)            :: ndet,nstates,dim_psicoef
+  integer, intent(in)            :: ndet,nstates,dim_psicoef,sze
-  integer(bit_kind), intent(in)  :: psidet(N_int,2,ndet)
+  integer(bit_kind), intent(in)  :: psidet(N_int,2,sze)
   double precision, intent(in)   :: psilcoef(dim_psicoef,nstates)
   double precision, intent(in)   :: psircoef(dim_psicoef,nstates)
   integer*8, allocatable         :: psi_det_save(:,:,:)
@@ -188,23 +188,17 @@ subroutine save_tc_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psilcoef
     call ezfio_set_tc_bi_ortho_psi_r_coef_bi_ortho(psir_coef_save)
     deallocate (psil_coef_save,psir_coef_save)
 
-!    allocate (psi_coef_save(ndet_qp_edit,nstates))
-!    do k=1,nstates
-!      do i=1,ndet_qp_edit
-!        psi_coef_save(i,k) = psicoef(i,k)
-!      enddo
-!    enddo
-!
-!    call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save)
-!    deallocate (psi_coef_save)
-
     call write_int(6,ndet,'Saved determinantsi and psi_r/psi_l coef')
   endif
 end
 
 subroutine save_tc_bi_ortho_wavefunction
  implicit none
- call save_tc_wavefunction_general(N_det,N_states,psi_det,size(psi_l_coef_bi_ortho, 1),psi_l_coef_bi_ortho,psi_r_coef_bi_ortho)
+ if(save_sorted_tc_wf)then
+  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,psi_r_coef_bi_ortho)
+ endif
  call routine_save_right_bi_ortho
 end
 
@@ -214,9 +208,9 @@ subroutine routine_save_right_bi_ortho
  integer :: i
  allocate(coef_tmp(N_det, N_states))
  do i = 1, N_det
-  coef_tmp(i,1:N_states) = psi_r_coef_bi_ortho(i,1:N_states)
+  coef_tmp(i,1:N_states) = psi_r_coef_sorted_bi_ortho(i,1:N_states)
  enddo
- call save_wavefunction_general_unormalized(N_det,N_states,psi_det,size(coef_tmp,1),coef_tmp(1,1))
+ call save_wavefunction_general_unormalized(N_det,N_states,psi_det_sorted_tc,size(coef_tmp,1),coef_tmp(1,1))
 end                     
 
 subroutine routine_save_left_right_bi_ortho

src/tc_bi_ortho/tc_bi_ortho.irp.f

@@ -11,7 +11,7 @@ program tc_bi_ortho
   touch read_wf
   touch  my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
   call routine_diag
-! call test
+  call save_tc_bi_ortho_wavefunction
 end
 
 subroutine test
@@ -19,18 +19,19 @@ subroutine test
  integer :: i,j 
  double precision :: hmono,htwoe,hthree,htot
  use bitmasks
-
+ print*,'reading the wave function '
- print*,'test'
+ do i = 1, N_det
-! call htilde_mu_mat_bi_ortho(psi_det(1,1,1), psi_det(1,1,2), N_int, hmono, htwoe, hthree, htot)
+  call debug_det(psi_det(1,1,i),N_int)
- call double_htilde_mu_mat_bi_ortho(N_int,psi_det(1,1,1), psi_det(1,1,2), hmono, htwoe, htot)
+  print*,i,psi_l_coef_bi_ortho(i,1)*psi_r_coef_bi_ortho(i,1)
- print*,hmono, htwoe,  htot
+  print*,i,psi_l_coef_bi_ortho(i,1),psi_r_coef_bi_ortho(i,1)
+ enddo
 
 end
 
 subroutine routine_diag
  implicit none
 ! provide eigval_right_tc_bi_orth
-  provide overlap_bi_ortho
+!  provide overlap_bi_ortho
 !  provide htilde_matrix_elmt_bi_ortho
  integer ::i,j
  print*,'eigval_right_tc_bi_orth = ',eigval_right_tc_bi_orth(1)
@@ -46,16 +47,7 @@ subroutine routine_diag
  print*,'e_corr_double_bi_orth   = ',e_corr_double_bi_orth
  print*,'Left/right eigenvectors'
  do i = 1,N_det
-  write(*,'(I5,X,(100(F12.7,X)))')i,leigvec_tc_bi_orth(i,1),reigvec_tc_bi_orth(i,1)
+  write(*,'(I5,X,(100(F12.7,X)))')i,leigvec_tc_bi_orth(i,1),reigvec_tc_bi_orth(i,1),leigvec_tc_bi_orth(i,1)*reigvec_tc_bi_orth(i,1)
  enddo
- do j=1,N_states
-   do i=1,N_det
-     psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
-     psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
-   enddo
- enddo
- SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
- call save_tc_bi_ortho_wavefunction
-! call routine_save_left_right_bi_ortho
 end
 

src/tc_bi_ortho/tc_h_eigvectors.irp.f

@@ -12,6 +12,25 @@
  enddo
  END_PROVIDER
 
+subroutine diagonalize_CI_tc
+  implicit none
+  BEGIN_DOC
+!  Replace the coefficients of the |CI| states by the coefficients of the
+!  eigenstates of the |CI| matrix.
+  END_DOC
+  integer                        :: i,j
+  do j=1,N_states
+    do i=1,N_det
+      psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
+      psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
+    enddo
+  enddo
+!  psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
+!  psi_s2(1:N_states) = CI_s2(1:N_states)
+
+  SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
+end
+
 
 
  BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth, (N_states)]
@@ -133,10 +152,10 @@
   call bi_normalize(leigvec_tc_bi_orth,reigvec_tc_bi_orth,size(reigvec_tc_bi_orth,1),N_det,N_states)
    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)
    norm_ground_left_right_bi_orth = 0.d0
-   print*,'after diago'
+!   print*,'after diago'
    do j = 1, N_det
-    call debug_det(psi_det(1,1,j),N_int)
+!    call debug_det(psi_det(1,1,j),N_int)
-    print*,j,dabs(leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1))
+!    print*,j,dabs(leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1))
     norm_ground_left_right_bi_orth += leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1)
    enddo
    print*,'norm l/r = ',norm_ground_left_right_bi_orth

src/tc_keywords/EZFIO.cfg

@@ -207,3 +207,11 @@ type: logical
 doc: If |true|, only the right part of WF is used to compute spin dens
 interface: ezfio,provider,ocaml
 default: False
+
+[save_sorted_tc_wf]
+type: logical
+doc: If |true|, save the bi-ortho wave functions in a sorted way
+interface: ezfio,provider,ocaml
+default: True
+
+