quantum_package/plugins/eginer/FOBOCI/new_new_approach.irp.f

program test_new_new
 implicit none 
 read_wf = .True.
 touch read_wf
 call test
end


subroutine test
 implicit none
 integer :: i,j,k,l
 call diagonalize_CI 
 call set_generators_to_psi_det
 print*,'Initial coefficients'
 do i = 1, N_det
  print*,''
  call debug_det(psi_det(1,1,i),N_int)
  print*,'psi_coef = ',psi_coef(i,1) 
  print*,''
 enddo
 double precision, allocatable :: dressing_matrix(:,:)
 double precision :: hij 
 double precision :: phase
 integer :: n_h,n_p,number_of_holes,number_of_particles
 integer :: exc(0:2,2,2)
 integer :: degree
 integer :: h1,h2,p1,p2,s1,s2
 allocate(dressing_matrix(N_det_generators,N_det_generators))
 do i = 1, N_det_generators
  do j = 1, N_det_generators 
   call i_h_j(psi_det_generators(1,1,i),psi_det_generators(1,1,j),N_int,hij)
   dressing_matrix(i,j) = hij
  enddo
 enddo
 href =  dressing_matrix(1,1)
 print*,'Diagonal part of the dressing'
 do i = 1, N_det_generators
  print*,'delta e = ',dressing_matrix(i,i) - href
 enddo
 call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix)
 double precision :: href
 print*,''
 ! One considers that the following excitation classes are not repeatable on the 1h and 1p determinants : 
 !   + 1h1p spin flip
 !   + 2h1p 
 !   + 1h2p 
 ! But the 2h2p are correctly taken into account 
!dressing_matrix(1,1) += total_corr_e_1h2p + total_corr_e_2h1p + total_corr_e_1h1p_spin_flip
!do i = 1, N_det_generators
! dressing_matrix(i,i) += total_corr_e_2h2p 
!  n_h = number_of_holes(psi_det(1,1,i))
!  n_p = number_of_particles(psi_det(1,1,i))
!  if(n_h == 1 .and. n_p ==0)then
!   
!   call get_excitation(ref_bitmask,psi_det_generators(1,1,i),exc,degree,phase,N_int)
!   call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
!   print*,''
!   print*,' 1h det '
!   print*,''
!   call debug_det(psi_det_generators(1,1,i),N_int)
!   print*,'h1,p1 = ',h1,p1
!   print*,'total_corr_e_2h2p         ',total_corr_e_2h2p
!   print*,'corr_energy_2h2p_per_orb_ab(h1)',corr_energy_2h2p_per_orb_ab(h1) 
!   print*,'corr_energy_2h2p_per_orb_bb(h1)',corr_energy_2h2p_per_orb_bb(h1) 
!   dressing_matrix(i,i) += -corr_energy_2h2p_per_orb_ab(h1) - corr_energy_2h2p_per_orb_bb(h1)
!   dressing_matrix(1,1) += -corr_energy_2h1p_per_orb_aa(h1) - corr_energy_2h1p_per_orb_ab(h1) -corr_energy_2h1p_per_orb_bb(h1) & 
!                           -corr_energy_1h1p_spin_flip_per_orb(h1)
!  endif
!  if(n_h == 0 .and. n_p ==1)then
!   call get_excitation(ref_bitmask,psi_det_generators(1,1,i),exc,degree,phase,N_int)
!   call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
!   print*,''
!   print*,' 1p det '
!   print*,''
!   call debug_det(psi_det_generators(1,1,i),N_int)
!   print*,'h1,p1 = ',h1,p1
!   print*,'total_corr_e_2h2p         ',total_corr_e_2h2p
!   print*,'corr_energy_2h2p_per_orb_ab(p1)',corr_energy_2h2p_per_orb_ab(p1) 
!   print*,'corr_energy_2h2p_per_orb_aa(p1)',corr_energy_2h2p_per_orb_aa(p1) 
!   dressing_matrix(i,i) += -corr_energy_2h2p_per_orb_ab(p1) - corr_energy_2h2p_per_orb_aa(p1)
!   dressing_matrix(1,1) += -corr_energy_1h2p_per_orb_aa(p1) - corr_energy_1h2p_per_orb_ab(p1) -corr_energy_1h2p_per_orb_bb(p1)
!  endif
!enddo
!href =  dressing_matrix(1,1)
!print*,'Diagonal part of the dressing'
!do i = 1, N_det_generators
! print*,'delta e = ',dressing_matrix(i,i) - href
!enddo
 call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
 print*,'After dressing matrix'
 print*,''
 print*,''
 do i = 1, N_det
  print*,'psi_coef = ',psi_coef(i,1) 
 enddo
!print*,''
!print*,''
!print*,'Canceling the dressing part of the interaction between 1h and 1p'
!do i = 2, N_det_generators
! do j = i+1, N_det_generators
!  call i_h_j(psi_det_generators(1,1,i),psi_det_generators(1,1,j),N_int,hij)
!  dressing_matrix(i,j) = hij
!  dressing_matrix(j,i) = hij 
! enddo
!enddo
!call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
!print*,''
!print*,''
!do i = 1, N_det
! print*,'psi_coef = ',psi_coef(i,1) 
!enddo
!print*,''
!print*,''
!print*,'Canceling the interaction between 1h and 1p'

!print*,''
!print*,''
!do i = 2, N_det_generators
! do j = i+1, N_det_generators
!  dressing_matrix(i,j) = 0.d0
!  dressing_matrix(j,i) = 0.d0
! enddo
!enddo
!call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
!do i = 1, N_det
! print*,'psi_coef = ',psi_coef(i,1) 
!enddo
 call save_natural_mos
 deallocate(dressing_matrix)


end