mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-24 21:41:46 +02:00
Added guess_lowest_state
This commit is contained in:
parent
2e27f8bd37
commit
1e15823494
@ -41,6 +41,15 @@ type(H_apply_buffer_type), pointer :: H_apply_buffer(:)
|
||||
call omp_init_lock(H_apply_buffer_lock(1,iproc))
|
||||
!$OMP END PARALLEL
|
||||
endif
|
||||
do iproc=2,nproc-1
|
||||
if (.not.allocated(H_apply_buffer(iproc)%det)) then
|
||||
print *, ' ===================== Error =================== '
|
||||
print *, 'H_apply_buffer_allocated should be provided outside'
|
||||
print *, 'of an OpenMP section'
|
||||
print *, ' =============================================== '
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -111,7 +120,6 @@ subroutine copy_H_apply_buffer_to_wf
|
||||
double precision, allocatable :: buffer_coef(:,:)
|
||||
integer :: i,j,k
|
||||
integer :: N_det_old
|
||||
integer :: iproc
|
||||
|
||||
PROVIDE H_apply_buffer_allocated
|
||||
|
||||
@ -158,7 +166,7 @@ subroutine copy_H_apply_buffer_to_wf
|
||||
enddo
|
||||
!$OMP PARALLEL DEFAULT(SHARED) &
|
||||
!$OMP PRIVATE(j,k,i) FIRSTPRIVATE(N_det_old) &
|
||||
!$OMP SHARED(N_int,H_apply_buffer,psi_det,psi_coef,N_states)
|
||||
!$OMP SHARED(N_int,H_apply_buffer,psi_det,psi_coef,N_states,psi_det_size)
|
||||
j=0
|
||||
!$ j=omp_get_thread_num()
|
||||
do k=0,j-1
|
||||
|
@ -8,6 +8,7 @@ BEGIN_PROVIDER [ integer, N_det ]
|
||||
logical :: exists
|
||||
character*64 :: label
|
||||
PROVIDE ezfio_filename
|
||||
PROVIDE nproc
|
||||
if (read_wf) then
|
||||
call ezfio_has_determinants_n_det(exists)
|
||||
if (exists) then
|
||||
|
170
src/Determinants/guess_lowest_state.irp.f
Normal file
170
src/Determinants/guess_lowest_state.irp.f
Normal file
@ -0,0 +1,170 @@
|
||||
program first_guess
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Select all the determinants with the lowest energy as a starting point.
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
double precision, allocatable :: orb_energy(:)
|
||||
double precision :: E
|
||||
integer, allocatable :: kept(:)
|
||||
integer :: nelec_kept(2)
|
||||
|
||||
PROVIDE H_apply_buffer_allocated
|
||||
allocate (orb_energy(mo_tot_num), kept(0:mo_tot_num))
|
||||
nelec_kept(1:2) = 0
|
||||
kept(0) = 0
|
||||
|
||||
do i=1,mo_tot_num
|
||||
orb_energy(i) = mo_mono_elec_integral(i,i)
|
||||
do j=1,elec_beta_num
|
||||
if (i==j) cycle
|
||||
orb_energy(i) += mo_bielec_integral_jj_anti(i,j)
|
||||
enddo
|
||||
do j=1,elec_alpha_num
|
||||
orb_energy(i) += mo_bielec_integral_jj(i,j)
|
||||
enddo
|
||||
if ( (orb_energy(i) > -1.d0).and.(orb_energy(i) < .5d0) ) then
|
||||
kept(0) += 1
|
||||
kept( kept(0) ) = i
|
||||
if (i <= elec_beta_num) then
|
||||
nelec_kept(2) += 1
|
||||
endif
|
||||
if (i <= elec_alpha_num) then
|
||||
nelec_kept(1) += 1
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
|
||||
integer, allocatable :: list (:,:)
|
||||
integer(bit_kind), allocatable :: string(:,:)
|
||||
allocate ( list(N_int*bit_kind_size,2), string(N_int,2) )
|
||||
|
||||
string = ref_bitmask
|
||||
call bitstring_to_list( string(1,1), list(1,1), elec_alpha_num, N_int)
|
||||
call bitstring_to_list( string(1,2), list(1,2), elec_beta_num , N_int)
|
||||
|
||||
psi_det_alpha_unique(:,1) = string(:,1)
|
||||
psi_det_beta_unique (:,1) = string(:,2)
|
||||
N_det_alpha_unique = 1
|
||||
N_det_beta_unique = 1
|
||||
|
||||
integer :: i1,i2,i3,i4,i5,i6,i7,i8,i9
|
||||
! select case (nelec_kept(1))
|
||||
!
|
||||
! case(0)
|
||||
! continue
|
||||
!
|
||||
! case(1)
|
||||
! do i1=kept(0),1,-1
|
||||
! list(elec_alpha_num-0,1) = kept(i1)
|
||||
! call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
|
||||
! N_det_alpha_unique += 1
|
||||
! psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1)
|
||||
! enddo
|
||||
!
|
||||
! case(2)
|
||||
! do i1=kept(0),1,-1
|
||||
! list(elec_alpha_num-0,1) = kept(i1)
|
||||
! call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
|
||||
! N_det_alpha_unique += 1
|
||||
! psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1)
|
||||
! do i2=i1-1,1,-1
|
||||
! list(elec_alpha_num-1,1) = kept(i2)
|
||||
! call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
|
||||
! N_det_alpha_unique += 1
|
||||
! psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1)
|
||||
! enddo
|
||||
! enddo
|
||||
|
||||
psi_det_size = kept(0)**(nelec_kept(1)+nelec_kept(2))
|
||||
TOUCH psi_det_size
|
||||
|
||||
BEGIN_SHELL [ /usr/bin/python ]
|
||||
|
||||
template_alpha_ext = """
|
||||
do %(i2)s = %(i1)s-1,1,-1
|
||||
list(elec_alpha_num-%(i)d,1) = kept(%(i2)s)
|
||||
call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
|
||||
"""
|
||||
|
||||
template_alpha = """
|
||||
do %(i2)s = %(i1)s-1,1,-1
|
||||
list(elec_alpha_num-%(i)d,1) = kept(%(i2)s)
|
||||
call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
|
||||
N_det_alpha_unique += 1
|
||||
psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1)
|
||||
"""
|
||||
|
||||
template_beta_ext = """
|
||||
do %(i2)s = %(i1)s-1,1,-1
|
||||
list(elec_beta_num-%(i)d,2) = kept(%(i2)s)
|
||||
call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int)
|
||||
"""
|
||||
template_beta = """
|
||||
do %(i2)s = %(i1)s-1,1,-1
|
||||
list(elec_beta_num-%(i)d,2) = kept(%(i2)s)
|
||||
call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int)
|
||||
N_det_beta_unique += 1
|
||||
psi_det_beta_unique(:,N_det_beta_unique) = string(:,2)
|
||||
"""
|
||||
|
||||
def write(template_ext,template,imax):
|
||||
print "case(%d)"%(imax)
|
||||
def aux(i2,i1,i,j):
|
||||
if (i==imax-1):
|
||||
print template%locals()
|
||||
else:
|
||||
print template_ext%locals()
|
||||
i += 1
|
||||
j -= 1
|
||||
if (i != imax):
|
||||
i1 = "i%d"%(i)
|
||||
i2 = "i%d"%(i+1)
|
||||
aux(i2,i1,i,j)
|
||||
print "enddo"
|
||||
|
||||
i2 = "i1"
|
||||
i1 = "kept(0)+1"
|
||||
i = 0
|
||||
aux(i2,i1,i,imax)
|
||||
|
||||
def main():
|
||||
print """
|
||||
select case (nelec_kept(1))
|
||||
case(0)
|
||||
continue
|
||||
"""
|
||||
for imax in range(1,10):
|
||||
write(template_alpha_ext,template_alpha,imax)
|
||||
|
||||
print """
|
||||
end select
|
||||
|
||||
select case (nelec_kept(2))
|
||||
case(0)
|
||||
continue
|
||||
"""
|
||||
for imax in range(1,10):
|
||||
write(template_beta_ext,template_beta,imax)
|
||||
print "end select"
|
||||
|
||||
main()
|
||||
|
||||
END_SHELL
|
||||
|
||||
TOUCH N_det_alpha_unique N_det_beta_unique psi_det_alpha_unique psi_det_beta_unique
|
||||
call create_wf_of_psi_bilinear_matrix(.False.)
|
||||
call diagonalize_ci
|
||||
j= N_det
|
||||
do i=1,N_det
|
||||
if (psi_average_norm_contrib_sorted(i) < 1.d-6) then
|
||||
j = i-1
|
||||
exit
|
||||
endif
|
||||
! call debug_det(psi_det_sorted(1,1,i),N_int)
|
||||
enddo
|
||||
call save_wavefunction_general(j,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
|
||||
|
||||
deallocate(orb_energy, kept, list, string)
|
||||
end
|
@ -1,138 +0,0 @@
|
||||
program pouet
|
||||
implicit none
|
||||
print*,'HF energy = ',ref_bitmask_energy + nuclear_repulsion
|
||||
call routine
|
||||
|
||||
end
|
||||
subroutine routine
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer :: i,j,k,l
|
||||
double precision :: hij,get_mo_bielec_integral
|
||||
double precision :: hmono,h_bi_ispin,h_bi_other_spin
|
||||
integer(bit_kind),allocatable :: key_tmp(:,:)
|
||||
integer, allocatable :: occ(:,:)
|
||||
integer :: n_occ_alpha, n_occ_beta
|
||||
! First checks
|
||||
print*,'N_int = ',N_int
|
||||
print*,'mo_tot_num = ',mo_tot_num
|
||||
print*,'mo_tot_num / 64+1= ',mo_tot_num/64+1
|
||||
! We print the HF determinant
|
||||
do i = 1, N_int
|
||||
print*,'ref_bitmask(i,1) = ',ref_bitmask(i,1)
|
||||
print*,'ref_bitmask(i,2) = ',ref_bitmask(i,2)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'Hartree Fock determinant ...'
|
||||
call debug_det(ref_bitmask,N_int)
|
||||
allocate(key_tmp(N_int,2))
|
||||
! We initialize key_tmp to the Hartree Fock one
|
||||
key_tmp = ref_bitmask
|
||||
integer :: i_hole,i_particle,ispin,i_ok,other_spin
|
||||
! We do a mono excitation on the top of the HF determinant
|
||||
write(*,*)'Enter the (hole, particle) couple for the mono excitation ...'
|
||||
read(5,*)i_hole,i_particle
|
||||
!!i_hole = 4
|
||||
!!i_particle = 20
|
||||
write(*,*)'Enter the ispin variable ...'
|
||||
write(*,*)'ispin = 1 ==> alpha '
|
||||
write(*,*)'ispin = 2 ==> beta '
|
||||
read(5,*)ispin
|
||||
if(ispin == 1)then
|
||||
other_spin = 2
|
||||
else if(ispin == 2)then
|
||||
other_spin = 1
|
||||
else
|
||||
print*,'PB !! '
|
||||
print*,'ispin must be 1 or 2 !'
|
||||
stop
|
||||
endif
|
||||
!!ispin = 1
|
||||
call do_mono_excitation(key_tmp,i_hole,i_particle,ispin,i_ok)
|
||||
! We check if it the excitation was possible with "i_ok"
|
||||
if(i_ok == -1)then
|
||||
print*,'i_ok = ',i_ok
|
||||
print*,'You can not do this excitation because of Pauli principle ...'
|
||||
print*,'check your hole particle couple, there must be something wrong ...'
|
||||
stop
|
||||
|
||||
endif
|
||||
print*,'New det = '
|
||||
call debug_det(key_tmp,N_int)
|
||||
call i_H_j(key_tmp,ref_bitmask,N_int,hij)
|
||||
! We calculate the H matrix element between the new determinant and HF
|
||||
print*,'<D_i|H|D_j> = ',hij
|
||||
print*,''
|
||||
print*,''
|
||||
print*,'Recalculating it old school style ....'
|
||||
print*,''
|
||||
print*,''
|
||||
! We recalculate this old school style !!!
|
||||
! Mono electronic part
|
||||
hmono = mo_mono_elec_integral(i_hole,i_particle)
|
||||
print*,''
|
||||
print*,'Mono electronic part '
|
||||
print*,''
|
||||
print*,'<D_i|h(1)|D_j> = ',hmono
|
||||
h_bi_ispin = 0.d0
|
||||
h_bi_other_spin = 0.d0
|
||||
print*,''
|
||||
print*,'Getting all the info for the calculation of the bi electronic part ...'
|
||||
print*,''
|
||||
allocate (occ(N_int*bit_kind_size,2))
|
||||
! We get the occupation of the alpha electrons in occ(:,1)
|
||||
call bitstring_to_list(key_tmp(1,1), occ(1,1), n_occ_alpha, N_int)
|
||||
print*,'n_occ_alpha = ',n_occ_alpha
|
||||
print*,'elec_alpha_num = ',elec_alpha_num
|
||||
! We get the occupation of the beta electrons in occ(:,2)
|
||||
call bitstring_to_list(key_tmp(1,2), occ(1,2), n_occ_beta, N_int)
|
||||
print*,'n_occ_beta = ',n_occ_beta
|
||||
print*,'elec_beta_num = ',elec_beta_num
|
||||
! We print the occupation of the alpha electrons
|
||||
print*,'Alpha electrons !'
|
||||
do i = 1, n_occ_alpha
|
||||
print*,'i = ',i
|
||||
print*,'occ(i,1) = ',occ(i,1)
|
||||
enddo
|
||||
! We print the occupation of the beta electrons
|
||||
print*,'Alpha electrons !'
|
||||
do i = 1, n_occ_beta
|
||||
print*,'i = ',i
|
||||
print*,'occ(i,2) = ',occ(i,2)
|
||||
enddo
|
||||
integer :: exc(0:2,2,2),degree,h1,p1,h2,p2,s1,s2
|
||||
double precision :: phase
|
||||
|
||||
call get_excitation_degree(key_tmp,ref_bitmask,degree,N_int)
|
||||
print*,'degree = ',degree
|
||||
call get_mono_excitation(ref_bitmask,key_tmp,exc,phase,N_int)
|
||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
print*,'h1 = ',h1
|
||||
print*,'p1 = ',p1
|
||||
print*,'s1 = ',s1
|
||||
print*,'phase = ',phase
|
||||
do i = 1, elec_num_tab(ispin)
|
||||
integer :: orb_occupied
|
||||
orb_occupied = occ(i,ispin)
|
||||
h_bi_ispin += get_mo_bielec_integral(i_hole,orb_occupied,i_particle,orb_occupied,mo_integrals_map) &
|
||||
-get_mo_bielec_integral(i_hole,i_particle,orb_occupied,orb_occupied,mo_integrals_map)
|
||||
enddo
|
||||
print*,'h_bi_ispin = ',h_bi_ispin
|
||||
|
||||
do i = 1, elec_num_tab(other_spin)
|
||||
orb_occupied = occ(i,other_spin)
|
||||
h_bi_other_spin += get_mo_bielec_integral(i_hole,orb_occupied,i_particle,orb_occupied,mo_integrals_map)
|
||||
enddo
|
||||
print*,'h_bi_other_spin = ',h_bi_other_spin
|
||||
print*,'h_bi_ispin + h_bi_other_spin = ',h_bi_ispin + h_bi_other_spin
|
||||
|
||||
print*,'Total matrix element = ',phase*(h_bi_ispin + h_bi_other_spin + hmono)
|
||||
!i = 1
|
||||
!j = 1
|
||||
!k = 1
|
||||
!l = 1
|
||||
!hij = get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
|
||||
!print*,'<ij|kl> = ',hij
|
||||
|
||||
|
||||
end
|
@ -442,13 +442,14 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix, (N_det_alpha_unique,N_de
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
subroutine create_wf_of_psi_bilinear_matrix
|
||||
subroutine create_wf_of_psi_bilinear_matrix(truncate)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Generate a wave function containing all possible products
|
||||
! of alpha and beta determinants
|
||||
END_DOC
|
||||
logical, intent(in) :: truncate
|
||||
integer :: i,j,k
|
||||
integer(bit_kind) :: tmp_det(N_int,2)
|
||||
integer :: idx
|
||||
@ -488,8 +489,10 @@ subroutine create_wf_of_psi_bilinear_matrix
|
||||
norm(1) = 0.d0
|
||||
do i=1,N_det
|
||||
norm(1) += psi_average_norm_contrib_sorted(i)
|
||||
if (norm(1) >= 0.999999d0) then
|
||||
exit
|
||||
if (truncate) then
|
||||
if (norm(1) >= 0.999999d0) then
|
||||
exit
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
N_det = min(i,N_det)
|
||||
@ -532,7 +535,6 @@ subroutine generate_all_alpha_beta_det_products
|
||||
!$OMP END DO NOWAIT
|
||||
deallocate(tmp_det)
|
||||
!$OMP END PARALLEL
|
||||
deallocate (tmp_det)
|
||||
call copy_H_apply_buffer_to_wf
|
||||
SOFT_TOUCH psi_det psi_coef N_det
|
||||
end
|
||||
|
@ -8,10 +8,10 @@ program cisd
|
||||
N_det=10000
|
||||
do i=1,N_det
|
||||
do k=1,N_int
|
||||
psi_det(k,1,i) = psi_det_sorted(k,1,i)
|
||||
psi_det(k,2,i) = psi_det_sorted(k,2,i)
|
||||
psi_det(k,1,i) = psi_det_sorted(k,1,i)
|
||||
psi_det(k,2,i) = psi_det_sorted(k,2,i)
|
||||
enddo
|
||||
psi_coef(k,:) = psi_coef_sorted(k,:)
|
||||
psi_coef(i,:) = psi_coef_sorted(i,:)
|
||||
enddo
|
||||
TOUCH psi_det psi_coef psi_det_sorted psi_coef_sorted psi_average_norm_contrib_sorted N_det
|
||||
call save_wavefunction
|
||||
|
Loading…
Reference in New Issue
Block a user