10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-27 06:43:48 +01:00
quantum_package/plugins/eginer/FOBOCI/all_singles_split.irp.f

536 lines
23 KiB
Fortran
Raw Normal View History

2016-02-17 17:15:54 +01:00
subroutine all_single_split(psi_det_generators_input,psi_coef_generators_input,Ndet_generators_input,dressing_matrix)
implicit none
use bitmasks
integer, intent(in) :: Ndet_generators_input
integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators_input)
double precision, intent(inout) :: dressing_matrix(Ndet_generators_input,Ndet_generators_input)
double precision, intent(in) :: psi_coef_generators_input(ndet_generators_input,n_states)
2016-03-11 23:27:39 +01:00
integer :: i,i_hole,j
2016-02-17 17:15:54 +01:00
n_det_max_jacobi = 50
soft_touch n_det_max_jacobi
do i = 1, n_inact_orb
i_hole = list_inact(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
soft_touch threshold_davidson davidson_criterion
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call all_single
2016-03-11 23:27:39 +01:00
! call diagonalize_CI_SC2
! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2)
call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input)
enddo
do i = 1, n_act_orb
i_hole = list_act(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
2016-02-17 17:15:54 +01:00
soft_touch threshold_davidson davidson_criterion
2016-03-11 23:27:39 +01:00
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call all_single
! call diagonalize_CI_SC2
! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2)
call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input)
enddo
do i = 1, n_virt_orb
i_hole = list_virt(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
soft_touch threshold_davidson davidson_criterion
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input)
call all_single
! call diagonalize_CI_SC2
! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2)
2016-02-17 17:15:54 +01:00
call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input)
enddo
2016-03-11 23:27:39 +01:00
2016-02-17 17:15:54 +01:00
n_det_max_jacobi = 1000
soft_touch n_det_max_jacobi
end
2016-03-11 23:27:39 +01:00
subroutine all_single_for_1p(i_particl,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p)
implicit none
use bitmasks
integer, intent(in) :: i_particl
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)
integer :: i,j
n_det_max_jacobi = 50
soft_touch n_det_max_jacobi
call all_single
threshold_davidson = 1.d-12
soft_touch threshold_davidson davidson_criterion
call diagonalize_CI
double precision, allocatable :: matrix_ref_1h_1p(:,:)
double precision, allocatable :: matrix_ref_1h_1p_dressing_1h1p(:,:)
double precision, allocatable :: matrix_ref_1h_1p_dressing_1h2p(:,:)
double precision, allocatable :: psi_coef_ref_1h_1p(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_1h2p(:,:)
integer(bit_kind), allocatable :: psi_det_1h2p(:,:,:)
integer(bit_kind), allocatable :: psi_det_ref_1h_1p(:,:,:)
integer(bit_kind), allocatable :: psi_det_1h1p(:,:,:)
integer :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p
double precision :: hka
double precision,allocatable :: eigenvectors(:,:), eigenvalues(:)
call give_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p)
allocate(matrix_ref_1h_1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_1h1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_1h2p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p), psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states))
allocate(psi_det_1h2p(N_int,2,n_det_1h2p), psi_coef_1h2p(n_det_1h2p,N_states))
allocate(psi_det_1h1p(N_int,2,n_det_1h1p), psi_coef_1h1p(n_det_1h1p,N_states))
call give_wf_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,&
psi_det_1h2p,psi_coef_1h2p,psi_det_1h1p,psi_coef_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
call i_h_j(psi_det_ref_1h_1p(1,1,i),psi_det_ref_1h_1p(1,1,j),N_int,hka)
matrix_ref_1h_1p(i,j) = hka
enddo
enddo
matrix_ref_1h_1p_dressing_1h1p = 0.d0
matrix_ref_1h_1p_dressing_1h2p = 0.d0
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h2p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_1h2p,psi_coef_1h2p,n_det_1h2p)
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_1h1p,psi_coef_1h1p,n_det_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
matrix_ref_1h_1p(i,j) += matrix_ref_1h_1p_dressing_1h2p(i,j) + matrix_ref_1h_1p_dressing_1h1p(i,j)
enddo
enddo
allocate(eigenvectors(n_det_ref_1h_1p,n_det_ref_1h_1p), eigenvalues(n_det_ref_1h_1p))
call lapack_diag(eigenvalues,eigenvectors,matrix_ref_1h_1p,n_det_ref_1h_1p,n_det_ref_1h_1p)
!do j = 1, n_det_ref_1h_1p
! print*,'coef = ',eigenvectors(j,1)
!enddo
print*,''
print*,'-----------------------'
print*,'-----------------------'
print*,'e_dressed = ',eigenvalues(1)+nuclear_repulsion
print*,'-----------------------'
! Extract the
integer, allocatable :: index_generator(:)
integer :: n_det_generators_tmp,degree
n_det_generators_tmp = 0
allocate(index_generator(n_det_ref_1h_1p))
do i = 1, n_det_ref_1h_1p
do j = 1, N_det_generators
call get_excitation_degree(psi_det_generators(1,1,j),psi_det_ref_1h_1p(1,1,i), degree, N_int)
if(degree == 0)then
n_det_generators_tmp +=1
index_generator(n_det_generators_tmp) = i
endif
enddo
enddo
if(n_det_generators_tmp .ne. n_det_generators)then
print*,'PB !!!'
print*,'if(n_det_generators_tmp .ne. n_det_genrators)then'
stop
endif
do i = 1, N_det_generators
print*,'psi_coef_dressed = ',eigenvectors(index_generator(i),1)
do j = 1, N_det_generators
dressing_matrix_1h1p(i,j) += matrix_ref_1h_1p_dressing_1h1p(index_generator(i),index_generator(j))
dressing_matrix_1h2p(i,j) += matrix_ref_1h_1p_dressing_1h2p(index_generator(i),index_generator(j))
enddo
enddo
print*,'-----------------------'
print*,'-----------------------'
deallocate(matrix_ref_1h_1p)
deallocate(matrix_ref_1h_1p_dressing_1h1p)
deallocate(matrix_ref_1h_1p_dressing_1h2p)
deallocate(psi_det_ref_1h_1p, psi_coef_ref_1h_1p)
deallocate(psi_det_1h2p, psi_coef_1h2p)
deallocate(psi_det_1h1p, psi_coef_1h1p)
deallocate(eigenvectors,eigenvalues)
deallocate(index_generator)
end
2016-02-19 17:32:35 +01:00
subroutine all_single_for_1h(i_hole,dressing_matrix_1h1p,dressing_matrix_2h1p,dressing_matrix_extra_1h_or_1p)
2016-02-17 17:15:54 +01:00
implicit none
use bitmasks
2016-02-19 17:32:35 +01:00
integer, intent(in) :: i_hole
2016-02-17 17:15:54 +01:00
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_2h1p(N_det_generators,N_det_generators)
2016-02-19 17:32:35 +01:00
double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)
2016-03-11 23:27:39 +01:00
integer :: i,j
2016-02-17 17:15:54 +01:00
n_det_max_jacobi = 50
soft_touch n_det_max_jacobi
2016-02-19 17:32:35 +01:00
call all_single
2016-02-17 17:15:54 +01:00
threshold_davidson = 1.d-12
soft_touch threshold_davidson davidson_criterion
call diagonalize_CI
2016-03-11 23:27:39 +01:00
double precision, allocatable :: matrix_ref_1h_1p(:,:)
double precision, allocatable :: matrix_ref_1h_1p_dressing_1h1p(:,:)
double precision, allocatable :: matrix_ref_1h_1p_dressing_2h1p(:,:)
double precision, allocatable :: psi_coef_ref_1h_1p(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_2h1p(:,:)
integer(bit_kind), allocatable :: psi_det_2h1p(:,:,:)
integer(bit_kind), allocatable :: psi_det_ref_1h_1p(:,:,:)
integer(bit_kind), allocatable :: psi_det_1h1p(:,:,:)
integer :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p
double precision :: hka
double precision,allocatable :: eigenvectors(:,:), eigenvalues(:)
call give_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p)
allocate(matrix_ref_1h_1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_1h1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(matrix_ref_1h_1p_dressing_2h1p(n_det_ref_1h_1p,n_det_ref_1h_1p))
allocate(psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p), psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states))
allocate(psi_det_2h1p(N_int,2,n_det_2h1p), psi_coef_2h1p(n_det_2h1p,N_states))
allocate(psi_det_1h1p(N_int,2,n_det_1h1p), psi_coef_1h1p(n_det_1h1p,N_states))
call give_wf_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,&
psi_det_2h1p,psi_coef_2h1p,psi_det_1h1p,psi_coef_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
call i_h_j(psi_det_ref_1h_1p(1,1,i),psi_det_ref_1h_1p(1,1,j),N_int,hka)
matrix_ref_1h_1p(i,j) = hka
enddo
enddo
matrix_ref_1h_1p_dressing_1h1p = 0.d0
matrix_ref_1h_1p_dressing_2h1p = 0.d0
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_2h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_2h1p,psi_coef_2h1p,n_det_2h1p)
call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, &
psi_det_1h1p,psi_coef_1h1p,n_det_1h1p)
do i = 1, n_det_ref_1h_1p
do j = 1, n_det_ref_1h_1p
matrix_ref_1h_1p(i,j) += matrix_ref_1h_1p_dressing_2h1p(i,j) + matrix_ref_1h_1p_dressing_1h1p(i,j)
enddo
enddo
allocate(eigenvectors(n_det_ref_1h_1p,n_det_ref_1h_1p), eigenvalues(n_det_ref_1h_1p))
call lapack_diag(eigenvalues,eigenvectors,matrix_ref_1h_1p,n_det_ref_1h_1p,n_det_ref_1h_1p)
!do j = 1, n_det_ref_1h_1p
! print*,'coef = ',eigenvectors(j,1)
!enddo
print*,''
print*,'-----------------------'
print*,'-----------------------'
print*,'e_dressed = ',eigenvalues(1)+nuclear_repulsion
print*,'-----------------------'
! Extract the
integer, allocatable :: index_generator(:)
integer :: n_det_generators_tmp,degree
n_det_generators_tmp = 0
allocate(index_generator(n_det_ref_1h_1p))
do i = 1, n_det_ref_1h_1p
do j = 1, N_det_generators
call get_excitation_degree(psi_det_generators(1,1,j),psi_det_ref_1h_1p(1,1,i), degree, N_int)
if(degree == 0)then
n_det_generators_tmp +=1
index_generator(n_det_generators_tmp) = i
endif
enddo
enddo
if(n_det_generators_tmp .ne. n_det_generators)then
print*,'PB !!!'
print*,'if(n_det_generators_tmp .ne. n_det_genrators)then'
stop
endif
do i = 1, N_det_generators
print*,'psi_coef_dressed = ',eigenvectors(index_generator(i),1)
do j = 1, N_det_generators
dressing_matrix_1h1p(i,j) += matrix_ref_1h_1p_dressing_1h1p(index_generator(i),index_generator(j))
dressing_matrix_2h1p(i,j) += matrix_ref_1h_1p_dressing_2h1p(index_generator(i),index_generator(j))
enddo
enddo
print*,'-----------------------'
print*,'-----------------------'
deallocate(matrix_ref_1h_1p)
deallocate(matrix_ref_1h_1p_dressing_1h1p)
deallocate(matrix_ref_1h_1p_dressing_2h1p)
deallocate(psi_det_ref_1h_1p, psi_coef_ref_1h_1p)
deallocate(psi_det_2h1p, psi_coef_2h1p)
deallocate(psi_det_1h1p, psi_coef_1h1p)
deallocate(eigenvectors,eigenvalues)
deallocate(index_generator)
!return
!
!integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
!integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
!integer(bit_kind), allocatable :: psi_2h1p(:,:,:)
!integer(bit_kind), allocatable :: psi_extra_1h_or_1p(:,:,:)
!double precision, allocatable :: psi_ref_coef_out(:,:)
!double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:)
!call all_single_no_1h_or_1p
!call give_n_1h1p_and_n_2h1p_in_psi_det(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p)
!allocate(psi_ref_out(N_int,2,N_det_generators))
!allocate(psi_1h1p(N_int,2,n_det_1h1p))
!allocate(psi_2h1p(N_int,2,n_det_2h1p))
!allocate(psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p))
!allocate(psi_ref_coef_out(N_det_generators,N_states))
!allocate(psi_coef_1h1p(n_det_1h1p,N_states))
!allocate(psi_coef_2h1p(n_det_2h1p,N_states))
!allocate(psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p,N_states))
!call split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p)
!do i = 1, n_det_extra_1h_or_1p
! print*,'----'
! print*,'c = ',psi_coef_extra_1h_or_1p(i,1)
! call debug_det(psi_extra_1h_or_1p(1,1,i),N_int)
! print*,'----'
!enddo
!call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_1h1p,psi_coef_1h1p,n_det_1h1p)
!print*,'Dressing 1h1p '
!do j =1, N_det_generators
! print*,' dressing ',dressing_matrix_1h1p(j,:)
!enddo
!call provide_matrix_dressing_general(dressing_matrix_2h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_2h1p,psi_coef_2h1p,n_det_2h1p)
!print*,'Dressing 2h1p '
!do j =1, N_det_generators
! print*,' dressing ',dressing_matrix_2h1p(j,:)
!enddo
!call provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix_extra_1h_or_1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p,n_det_extra_1h_or_1p)
!print*,',dressing_matrix_extra_1h_or_1p'
!do j =1, N_det_generators
! print*,' dressing ',dressing_matrix_extra_1h_or_1p(j,:)
!enddo
!deallocate(psi_ref_out)
!deallocate(psi_1h1p)
!deallocate(psi_2h1p)
!deallocate(psi_extra_1h_or_1p)
!deallocate(psi_ref_coef_out)
!deallocate(psi_coef_1h1p)
!deallocate(psi_coef_2h1p)
!deallocate(psi_coef_extra_1h_or_1p)
2016-02-17 17:15:54 +01:00
end
subroutine all_single_split_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p)
implicit none
use bitmasks
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_2h1p(N_det_generators,N_det_generators)
integer :: i,i_hole
n_det_max_jacobi = 50
soft_touch n_det_max_jacobi
integer :: n_det_1h1p,n_det_2h1p
integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
integer(bit_kind), allocatable :: psi_2h1p(:,:,:)
double precision, allocatable :: psi_ref_coef_out(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_2h1p(:,:)
do i = 1, n_inact_orb
i_hole = list_inact(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
soft_touch threshold_davidson davidson_criterion
selection_criterion_factor = 1.d-4
soft_touch selection_criterion_factor selection_criterion selection_criterion_min
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(n_det_generators,psi_det_generators,psi_coef_generators)
call set_psi_det_as_input_psi(n_det_generators,psi_det_generators,psi_coef_generators)
call all_single_no_1h_or_1p
threshold_davidson = 1.d-10
soft_touch threshold_davidson davidson_criterion
call diagonalize_CI
call give_n_1h1p_and_n_2h1p_in_psi_det(n_det_1h1p,n_det_2h1p)
allocate(psi_ref_out(N_int,2,N_det_generators))
allocate(psi_1h1p(N_int,2,n_det_1h1p))
allocate(psi_2h1p(N_int,2,n_det_2h1p))
allocate(psi_ref_coef_out(N_det_generators,N_states))
allocate(psi_coef_1h1p(n_det_1h1p,N_states))
allocate(psi_coef_2h1p(n_det_2h1p,N_states))
call split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p)
call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
psi_1h1p,psi_coef_1h1p,n_det_1h1p)
call provide_matrix_dressing_general(dressing_matrix_2h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
psi_2h1p,psi_coef_2h1p,n_det_2h1p)
deallocate(psi_ref_out)
deallocate(psi_1h1p)
deallocate(psi_2h1p)
deallocate(psi_ref_coef_out)
deallocate(psi_coef_1h1p)
deallocate(psi_coef_2h1p)
enddo
n_det_max_jacobi = 1000
soft_touch n_det_max_jacobi
end
subroutine all_single_split_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p)
implicit none
use bitmasks
double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators)
integer :: i,i_hole
n_det_max_jacobi = 50
soft_touch n_det_max_jacobi
integer :: n_det_1h1p,n_det_1h2p
integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
integer(bit_kind), allocatable :: psi_1h2p(:,:,:)
double precision, allocatable :: psi_ref_coef_out(:,:)
double precision, allocatable :: psi_coef_1h1p(:,:)
double precision, allocatable :: psi_coef_1h2p(:,:)
do i = 1, n_inact_orb
i_hole = list_inact(i)
print*,''
print*,'Doing all the single excitations from the orbital '
print*,i_hole
print*,''
print*,''
threshold_davidson = 1.d-4
soft_touch threshold_davidson davidson_criterion
selection_criterion_factor = 1.d-4
soft_touch selection_criterion_factor selection_criterion selection_criterion_min
call modify_bitmasks_for_hole(i_hole)
call set_bitmask_particl_as_input(reunion_of_bitmask)
call set_generators_as_input_psi(n_det_generators,psi_det_generators,psi_coef_generators)
call set_psi_det_as_input_psi(n_det_generators,psi_det_generators,psi_coef_generators)
call all_single_no_1h_or_1p
threshold_davidson = 1.d-10
soft_touch threshold_davidson davidson_criterion
call diagonalize_CI
call give_n_1h1p_and_n_1h2p_in_psi_det(n_det_1h1p,n_det_1h2p)
allocate(psi_ref_out(N_int,2,N_det_generators))
allocate(psi_1h1p(N_int,2,n_det_1h1p))
allocate(psi_1h2p(N_int,2,n_det_1h2p))
allocate(psi_ref_coef_out(N_det_generators,N_states))
allocate(psi_coef_1h1p(n_det_1h1p,N_states))
allocate(psi_coef_1h2p(n_det_1h2p,N_states))
call split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p)
call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
psi_1h1p,psi_coef_1h1p,n_det_1h1p)
call provide_matrix_dressing_general(dressing_matrix_1h2p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
psi_1h2p,psi_coef_1h2p,n_det_1h2p)
deallocate(psi_ref_out)
deallocate(psi_1h1p)
deallocate(psi_1h2p)
deallocate(psi_ref_coef_out)
deallocate(psi_coef_1h1p)
deallocate(psi_coef_1h2p)
enddo
n_det_max_jacobi = 1000
soft_touch n_det_max_jacobi
end
2016-03-11 23:27:39 +01:00
! subroutine all_single_for_1p(i_particl,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p)
! implicit none
! use bitmasks
! integer, intent(in ) :: i_particl
! double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators)
! double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators)
! double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)
! integer :: i
! n_det_max_jacobi = 50
! soft_touch n_det_max_jacobi
!
! integer :: n_det_1h1p,n_det_1h2p,n_det_extra_1h_or_1p
! integer(bit_kind), allocatable :: psi_ref_out(:,:,:)
! integer(bit_kind), allocatable :: psi_1h1p(:,:,:)
! integer(bit_kind), allocatable :: psi_1h2p(:,:,:)
! integer(bit_kind), allocatable :: psi_extra_1h_or_1p(:,:,:)
! double precision, allocatable :: psi_ref_coef_out(:,:)
! double precision, allocatable :: psi_coef_1h1p(:,:)
! double precision, allocatable :: psi_coef_1h2p(:,:)
! double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:)
!!!!call all_single_no_1h_or_1p_or_2p
! call all_single
!
! threshold_davidson = 1.d-12
! soft_touch threshold_davidson davidson_criterion
! call diagonalize_CI
! call give_n_1h1p_and_n_1h2p_in_psi_det(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p)
! allocate(psi_ref_out(N_int,2,N_det_generators))
! allocate(psi_1h1p(N_int,2,n_det_1h1p))
! allocate(psi_1h2p(N_int,2,n_det_1h2p))
! allocate(psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p))
! allocate(psi_ref_coef_out(N_det_generators,N_states))
! allocate(psi_coef_1h1p(n_det_1h1p,N_states))
! allocate(psi_coef_1h2p(n_det_1h2p,N_states))
! allocate(psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p,N_states))
! call split_wf_generators_and_1h1p_and_1h2p(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p)
! call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_1h1p,psi_coef_1h1p,n_det_1h1p)
! call provide_matrix_dressing_general(dressing_matrix_1h2p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_1h2p,psi_coef_1h2p,n_det_1h2p)
! call provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix_extra_1h_or_1p,psi_ref_out,psi_ref_coef_out,N_det_generators, &
! psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p,n_det_extra_1h_or_1p)
!
! deallocate(psi_ref_out)
! deallocate(psi_1h1p)
! deallocate(psi_1h2p)
! deallocate(psi_ref_coef_out)
! deallocate(psi_coef_1h1p)
! deallocate(psi_coef_1h2p)
!
! end
2016-02-17 17:15:54 +01:00