LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-03 20:54:00 +01:00
Code Issues Releases Wiki Activity

add CIS full for starting with CIS wave function

Browse Source
This commit is contained in:
Manu 2014-07-09 00:41:08 +02:00
parent a3f1fce4aa
commit 964a245737
9 changed files with 133 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/CIS/NEEDED_MODULES Normal file
View File

@ -0,0 +1,2 @@
AOs BiInts Bitmask Dets Electrons Ezfio_files Hartree_Fock MonoInts MOs Nuclei Output SingleRefMethod Utils Selectors_full

15
src/CIS_dressed/CIS_full.irp.f Normal file
View File

@ -0,0 +1,15 @@
program CIS_full
implicit none
integer :: i
provide eigenvalues_CIS
call save_cis
end
subroutine save_cis
do i = 1, n_state_cis
print*,'eigenvalues_CIS(i) = ',eigenvalues_CIS(i)
enddo
call save_wavefunction_general(size_psi_CIS,n_state_cis,psi_CIS,coefs_CIS)
end

16
src/CIS_dressed/CIS_providers.irp.f
View File

@ -45,13 +45,13 @@
psi_CIS(a,2,key)=ref_bitmask(a,2)
enddo
j_hole=ishft(i-1,-5)+1
i_hole=i-ishft(j_hole-1,5)-1
j_hole=ishft(i-1,-bit_kind_shift)+1
i_hole=i-ishft(j_hole-1,bit_kind_shift)-1
psi_CIS(j_hole,ispin,key)=ibclr(psi_CIS(j_hole,ispin,key),i_hole)
l_particle=ishft(k-1,-5)+1
k_particle=k-ishft(l_particle-1,5)-1
l_particle=ishft(k-1,-bit_kind_shift)+1
k_particle=k-ishft(l_particle-1,bit_kind_shift)-1
psi_CIS(l_particle,ispin,key)=ibset(psi_CIS(l_particle,ispin,key),k_particle)
@ -69,13 +69,13 @@
psi_CIS(a,2,key)=ref_bitmask(a,2)
enddo
j_hole=ishft(i-1,-5)+1
i_hole=i-ishft(j_hole-1,5)-1
j_hole=ishft(i-1,-bit_kind_shift)+1
i_hole=i-ishft(j_hole-1,bit_kind_shift)-1
psi_CIS(j_hole,ispin,key)=ibclr(psi_CIS(j_hole,ispin,key),i_hole)
l_particle=ishft(k-1,-5)+1
k_particle=k-ishft(l_particle-1,5)-1
l_particle=ishft(k-1,-bit_kind_shift)+1
k_particle=k-ishft(l_particle-1,bit_kind_shift)-1
psi_CIS_holes(key) = i
psi_CIS_particl(key) = k
psi_CIS_spin(key) = 2

16
src/CIS_dressed/MP2.irp.f
View File

@ -1573,16 +1573,16 @@ subroutine diexcitation(i,j,k,l,ispin1,ispin2,key_in,key_out,i_ok,Nint)
integer :: i_test_hole,i_test_particl
key_out = key_in
k_hole = ishft(i-1,-5)+1
j_hole = i-ishft(k_hole-1,5)-1
k_hole = ishft(i-1,-bit_kind_shift)+1
j_hole = i-ishft(k_hole-1,bit_kind_shift)-1
i_test_hole = ibset(0,j_hole)
if(iand(key_in(k_hole,ispin1),i_test_hole).ne.i_test_hole)then
i_ok = 0
return
endif
key_out(k_hole,ispin1) = ibclr(key_out(k_hole,ispin1),j_hole)
k_particl = ishft(k-1,-5)+1
j_particl = k-ishft(k_particl-1,5)-1
k_particl = ishft(k-1,-bit_kind_shift)+1
j_particl = k-ishft(k_particl-1,bit_kind_shift)-1
i_test_particl= ibset(0,j_particl)
if(iand(key_in(k_particl,ispin1),i_test_particl).ne.0)then
i_ok = 0
@ -1590,16 +1590,16 @@ subroutine diexcitation(i,j,k,l,ispin1,ispin2,key_in,key_out,i_ok,Nint)
endif
key_out(k_particl,ispin1) = ibset(key_out(k_particl,ispin1),j_particl)
k_hole = ishft(j-1,-5)+1
j_hole = j-ishft(k_hole-1,5)-1
k_hole = ishft(j-1,-bit_kind_shift)+1
j_hole = j-ishft(k_hole-1,bit_kind_shift)-1
i_test_hole = ibset(0,j_hole)
if(iand(key_in(k_hole,ispin2),i_test_hole).ne.i_test_hole)then
i_ok = 0
return
endif
key_out(k_hole,ispin2) = ibclr(key_out(k_hole,ispin2),j_hole)
k_particl = ishft(l-1,-5)+1
j_particl = l-ishft(k_particl-1,5)-1
k_particl = ishft(l-1,-bit_kind_shift)+1
j_particl = l-ishft(k_particl-1,bit_kind_shift)-1
i_test_particl = ibset(0,j_particl)
if(iand(key_in(k_particl,ispin2),i_test_particl).ne.0)then
i_ok = 0

1
src/Dets/determinants.ezfio_config
View File

@ -13,4 +13,5 @@ determinants
det_num integer
det_occ integer (electrons_elec_alpha_num,determinants_det_num,2)
det_coef double precision (determinants_det_num)
read_wf logical

68
src/Dets/determinants.irp.f
View File

@ -1,13 +1,5 @@
use bitmasks
BEGIN_PROVIDER [ logical, read_wf ]
implicit none
BEGIN_DOC
! If true, read the wave function from the EZFIO file
END_DOC
read_wf = .False.
END_PROVIDER
BEGIN_PROVIDER [ integer, N_states ]
implicit none
BEGIN_DOC
@ -161,6 +153,7 @@ subroutine read_dets(det,Nint,Ndet)
integer :: i,k
equivalence (det_8, det_bk)
! print*,'coucou'
call ezfio_get_determinants_N_int(N_int2)
ASSERT (N_int2 == Nint)
call ezfio_get_determinants_bit_kind(k)
@ -169,6 +162,9 @@ subroutine read_dets(det,Nint,Ndet)
N_int2 = (Nint*bit_kind)/8
allocate (psi_det_read(N_int2,2,Ndet))
call ezfio_get_determinants_psi_det (psi_det_read)
! print*,'N_int2 = ',N_int2,N_int
! print*,'k',k,bit_kind
! print*,'psi_det_read = ',Ndet
do i=1,Ndet
do k=1,N_int2
det_8(k) = psi_det_read(k,1,i)
@ -184,6 +180,7 @@ subroutine read_dets(det,Nint,Ndet)
enddo
enddo
deallocate(psi_det_read)
! print*,'ciao'
end
@ -347,6 +344,7 @@ end
subroutine save_wavefunction
implicit none
use bitmasks
BEGIN_DOC
! Save the wave function into the EZFIO file
END_DOC
@ -395,3 +393,57 @@ subroutine save_wavefunction
deallocate (psi_coef_save)
end
subroutine save_wavefunction_general(ndet,nstates,psidet,psicoef)
implicit none
BEGIN_DOC
! Save the wave function into the EZFIO file
END_DOC
use bitmasks
integer, intent(in) :: ndet,nstates
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
double precision, intent(in) :: psicoef(ndet,nstates)
integer*8, allocatable :: psi_det_save(:,:,:)
double precision, allocatable :: psi_coef_save(:,:)
integer*8 :: det_8(100)
integer(bit_kind) :: det_bk((100*8)/bit_kind)
integer :: N_int2
equivalence (det_8, det_bk)
integer :: i,k
call ezfio_set_determinants_N_int(N_int)
call ezfio_set_determinants_bit_kind(bit_kind)
call ezfio_set_determinants_N_det(ndet)
call ezfio_set_determinants_n_states(nstates)
call ezfio_set_determinants_mo_label(mo_label)
N_int2 = (N_int*bit_kind)/8
allocate (psi_det_save(N_int2,2,ndet))
do i=1,ndet
do k=1,N_int
det_bk(k) = psidet(k,1,i)
enddo
do k=1,N_int2
psi_det_save(k,1,i) = det_8(k)
enddo
do k=1,N_int
det_bk(k) = psidet(k,2,i)
enddo
do k=1,N_int2
psi_det_save(k,2,i) = det_8(k)
enddo
! print*,psi_det_save
enddo
call ezfio_set_determinants_psi_det(psi_det_save)
deallocate (psi_det_save)
allocate (psi_coef_save(ndet,nstates))
do k=1,nstates
do i=1,ndet
psi_coef_save(i,k) = psicoef(i,k)
enddo
enddo
call ezfio_set_determinants_psi_coef(psi_coef_save)
call write_int(output_dets,ndet,'Saved determinants')
deallocate (psi_coef_save)
end

17
src/Dets/parameters.irp.f Normal file
View File

@ -0,0 +1,17 @@
BEGIN_PROVIDER [ logical , read_wf ]
implicit none
BEGIN_DOC
! If true, read the wave function from the EZFIO file
END_DOC
logical :: exists
PROVIDE ezfio_filename
call ezfio_has_determinants_read_wf(exists)
if (exists) then
call ezfio_get_determinants_read_wf(read_wf)
else
read_wf = .True.
endif
!call write_i(output_determinants,read_wf,' computes the PT2 at the end of the selection ')
ASSERT (read_wf > 0)
END_PROVIDER

3
src/Full_CI/full_ci.ezfio_config Normal file
View File

@ -0,0 +1,3 @@
full_ci
n_det_max_fci integer
do_pt2_end logical

34
src/Full_CI/full_ci.irp.f
View File

@ -12,7 +12,7 @@ program cisd
pt2 = 1.d0
diag_algorithm = "Lapack"
! do while (maxval(abs(pt2(1:N_st))) > 1.d-4)
do while (N_det < 10000)
do while (N_det < n_det_max_fci.and.maxval(abs(pt2(1:N_st))) > 1.d-4)
call H_apply_FCI(pt2, norm_pert, H_pert_diag, N_st)
call diagonalize_CI
call save_wavefunction
@ -26,19 +26,23 @@ program cisd
exit
endif
enddo
N_det = 10000
touch N_det psi_det psi_coef
call diagonalize_CI
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
print *, 'Final step'
! call remove_small_contributions
! call diagonalize_CI
print *, 'N_det = ', N_det
print *, 'N_states = ', N_states
print *, 'PT2 = ', pt2
print *, 'E = ', CI_energy
print *, 'E+PT2 = ', CI_energy+pt2
print *, '-----'
N_det = min(n_det_max_fci,N_det)
if(do_pt2_end)then
threshold_selectors = 1.d0
threshold_generators = 0.999d0
touch N_det psi_det psi_coef
call diagonalize_CI
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
print *, 'Final step'
!! call remove_small_contributions
!! call diagonalize_CI
print *, 'N_det = ', N_det
print *, 'N_states = ', N_states
print *, 'PT2 = ', pt2
print *, 'E = ', CI_energy
print *, 'E+PT2 = ', CI_energy+pt2
print *, '-----'
endif
deallocate(pt2,norm_pert)
end