mirror of
https://github.com/LCPQ/quantum_package
synced 2025-01-03 10:05:57 +01:00
Working on MRCC
This commit is contained in:
parent
ad75f3fd68
commit
a95adca2c7
@ -54,4 +54,42 @@ program full_ci
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
! Check that it is a CAS-SD
|
||||
logical :: in_cas
|
||||
integer :: exc_max
|
||||
exc_max = 0
|
||||
print *, 'CAS determinants'
|
||||
do i=1,N_det_generators
|
||||
do k=i,N_det_generators
|
||||
call get_excitation_degree(psi_generators(1,1,k),psi_det(1,1,i),degree,N_int)
|
||||
exc_max = max(exc_max,degree)
|
||||
enddo
|
||||
call debug_det(psi_generators(1,1,i),N_int)
|
||||
print *, ''
|
||||
enddo
|
||||
print *, 'Max excitation degree in the CAS :', exc_max
|
||||
do i=1,N_det
|
||||
in_cas = .False.
|
||||
do k=1,N_det_generators
|
||||
call get_excitation_degree(psi_generators(1,1,k),psi_det(1,1,i),degree,N_int)
|
||||
if (degree == 0) then
|
||||
in_cas = .True.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (.not.in_cas) then
|
||||
do k=i,N_det
|
||||
call get_excitation_degree(psi_det(1,1,k),psi_det(1,1,i),degree,N_int)
|
||||
if (degree > exc_max+2) then
|
||||
print *, 'Error : This is not a CAS-SD : '
|
||||
print *, 'CAS determinant:'
|
||||
call debug_det(psi_det(1,1,i),N_int)
|
||||
print *, 'Excited determinant:', degree
|
||||
call debug_det(psi_det(1,1,k),N_int)
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
|
||||
@ -94,9 +94,10 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
|
||||
endif
|
||||
enddo
|
||||
i += 1
|
||||
if (i > N_det) then
|
||||
return
|
||||
endif
|
||||
|
||||
! if (i > N_det) then
|
||||
! return
|
||||
! endif
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref)
|
||||
@ -105,50 +106,49 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
|
||||
continue
|
||||
else
|
||||
is_in_wavefunction = .True.
|
||||
!DEC$ LOOP COUNT MIN(3)
|
||||
!DIR$ IVDEP
|
||||
!DIR$ LOOP COUNT MIN(3)
|
||||
do l=2,Nint
|
||||
if ( (key(l,1) /= psi_det_sorted_bit(l,1,i)).or. &
|
||||
(key(l,2) /= psi_det_sorted_bit(l,2,i)) ) then
|
||||
is_in_wavefunction = .False.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (is_in_wavefunction) then
|
||||
get_index_in_psi_det_sorted_bit = i
|
||||
exit
|
||||
! return
|
||||
endif
|
||||
endif
|
||||
i += 1
|
||||
if (i > N_det) then
|
||||
return
|
||||
! exit
|
||||
exit
|
||||
! return
|
||||
endif
|
||||
|
||||
enddo
|
||||
if (is_in_wavefunction) then
|
||||
get_index_in_psi_det_sorted_bit = i
|
||||
endif
|
||||
|
||||
! DEBUG is_in_wf
|
||||
! if (is_in_wavefunction) then
|
||||
! degree = 1
|
||||
! do i=1,N_det
|
||||
! integer :: degree
|
||||
! call get_excitation_degree(key,psi_det(1,1,i),degree,N_int)
|
||||
! if (degree == 0) then
|
||||
! exit
|
||||
! endif
|
||||
! enddo
|
||||
! if (degree /=0) then
|
||||
! stop 'pouet 1'
|
||||
! endif
|
||||
! else
|
||||
! do i=1,N_det
|
||||
! call get_excitation_degree(key,psi_det(1,1,i),degree,N_int)
|
||||
! if (degree == 0) then
|
||||
! stop 'pouet 2'
|
||||
! endif
|
||||
! enddo
|
||||
! endif
|
||||
if (is_in_wavefunction) then
|
||||
degree = 1
|
||||
do i=1,N_det
|
||||
integer :: degree
|
||||
call get_excitation_degree(key,psi_det(1,1,i),degree,N_int)
|
||||
if (degree == 0) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (degree /=0) then
|
||||
stop 'pouet 1'
|
||||
endif
|
||||
else
|
||||
do i=1,N_det
|
||||
call get_excitation_degree(key,psi_det(1,1,i),degree,N_int)
|
||||
if (degree == 0) then
|
||||
stop 'pouet 2'
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
! END DEBUG is_in_wf
|
||||
end
|
||||
|
||||
|
||||
@ -3,7 +3,23 @@ BEGIN_SHELL [ /usr/bin/env python ]
|
||||
from generate_h_apply import *
|
||||
|
||||
s = H_apply("mrcc")
|
||||
s.data["keys_work"] = "call mrcc_dress(i_generator,key_idx,keys_out,N_int,iproc)"
|
||||
s.data["parameters"] = ", delta_ij_sd_, Ndet_sd"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet_sd
|
||||
double precision, intent(in) :: delta_ij_sd_(Ndet_sd,Ndet_sd,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrcc_dress(delta_ij_sd_,Ndet_sd,i_generator,key_idx,keys_out,N_int,iproc)"
|
||||
s.data["params_post"] += ", delta_ij_sd_, Ndet_sd"
|
||||
s.data["params_main"] += "delta_ij_sd_, Ndet_sd"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet_sd
|
||||
double precision, intent(in) :: delta_ij_sd_(Ndet_sd,Ndet_sd,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "256"
|
||||
|
||||
print s
|
||||
|
||||
END_SHELL
|
||||
|
||||
@ -1 +1,2 @@
|
||||
AOs BiInts Bitmask CAS_SD_selected Dets Electrons Ezfio_files Generators_CAS Hartree_Fock MOGuess MonoInts MOs Nuclei Output Perturbation Properties Selectors_full Utils
|
||||
AOs BiInts Bitmask CAS_SD_selected Dets Electrons Ezfio_files Generators_CAS Generators_full Hartree_Fock MOGuess MonoInts MOs Nuclei Output Perturbation Properties Selectors_full Utils
|
||||
|
||||
|
||||
@ -1,4 +1,14 @@
|
||||
=======
|
||||
Module
|
||||
=======
|
||||
-4.142795384334731
|
||||
|
||||
4.695183071437694E-002
|
||||
Determinant 64
|
||||
---------------------------------------------
|
||||
000000000000002E|000000000000002E
|
||||
|-+++-+----------------------------------------------------------|
|
||||
|-+++-+----------------------------------------------------------|
|
||||
|
||||
CAS-SD: -4.14214374069306
|
||||
: -4.14230904320551
|
||||
|
||||
E0 = -11.5634986758976
|
||||
|
||||
|
||||
@ -1,57 +0,0 @@
|
||||
program full_ci
|
||||
implicit none
|
||||
integer :: i,k
|
||||
|
||||
|
||||
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
||||
integer :: N_st, degree
|
||||
N_st = N_states
|
||||
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
|
||||
character*(64) :: perturbation
|
||||
|
||||
pt2 = 1.d0
|
||||
diag_algorithm = "Lapack"
|
||||
if (N_det > n_det_max_fci) then
|
||||
call diagonalize_CI
|
||||
call save_wavefunction
|
||||
psi_det = psi_det_sorted
|
||||
psi_coef = psi_coef_sorted
|
||||
N_det = n_det_max_fci
|
||||
soft_touch N_det psi_det psi_coef
|
||||
call diagonalize_CI
|
||||
call save_wavefunction
|
||||
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
|
||||
|
||||
do while (N_det < n_det_max_fci.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
||||
call H_apply_FCI(pt2, norm_pert, H_pert_diag, N_st)
|
||||
|
||||
PROVIDE psi_coef
|
||||
PROVIDE psi_det
|
||||
PROVIDE psi_det_sorted
|
||||
|
||||
if (N_det > n_det_max_fci) then
|
||||
psi_det = psi_det_sorted
|
||||
psi_coef = psi_coef_sorted
|
||||
N_det = n_det_max_fci
|
||||
soft_touch N_det psi_det psi_coef
|
||||
endif
|
||||
call diagonalize_CI
|
||||
call save_wavefunction
|
||||
print *, 'N_det = ', N_det
|
||||
print *, 'N_states = ', N_states
|
||||
print *, 'PT2 = ', pt2
|
||||
print *, 'E = ', CI_energy
|
||||
print *, 'E+PT2 = ', CI_energy+pt2
|
||||
print *, '-----'
|
||||
call ezfio_set_full_ci_energy(CI_energy)
|
||||
if (abort_all) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
@ -2,17 +2,17 @@ program mrcc
|
||||
implicit none
|
||||
read_wf = .True.
|
||||
TOUCH read_wf
|
||||
call run
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
|
||||
print *, N_det
|
||||
print *, N_det_cas
|
||||
print *, N_det_sd
|
||||
! psi_cas, (N_int,2,N_det_generators) ]
|
||||
!psi_cas_coefs, (N_det_generators,n_states) ]
|
||||
!psi_sd, (N_int,2,psi_det_size) ]
|
||||
!psi_sd_coefs, (psi_det_size,n_states) ]
|
||||
|
||||
call update_generators
|
||||
! call update_generators
|
||||
integer :: i
|
||||
print *, 'CAS'
|
||||
print *, '==='
|
||||
@ -21,19 +21,23 @@ program mrcc
|
||||
call debug_det(psi_cas(1,1,i),N_int)
|
||||
enddo
|
||||
|
||||
print *, 'SD'
|
||||
print *, '=='
|
||||
do i=1,N_det_sd
|
||||
print *, psi_sd_coefs(i,:)
|
||||
call debug_det(psi_sd(1,1,i),N_int)
|
||||
enddo
|
||||
|
||||
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
||||
integer :: N_st, degree
|
||||
N_st = N_states
|
||||
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
|
||||
|
||||
! print *, 'SD'
|
||||
! print *, '=='
|
||||
! do i=1,N_det_sd
|
||||
! print *, psi_sd_coefs(i,:)
|
||||
! call debug_det(psi_sd(1,1,i),N_int)
|
||||
! enddo
|
||||
!
|
||||
print *, 'MRCC'
|
||||
print *, '===='
|
||||
call H_apply_mrcc(pt2, norm_pert, H_pert_diag, N_st)
|
||||
print *, ci_energy(:)
|
||||
print *, h_matrix_all_dets(3,3), delta_ij(3,3,1)
|
||||
print *, h_matrix_all_dets(3,3), delta_ij(3,3,1)
|
||||
print *, ci_energy_dressed(:)
|
||||
! print *, 'max', maxval(delta_ij_sd)
|
||||
! print *, 'min', minval(delta_ij_sd)
|
||||
!
|
||||
! do i=1,N_det
|
||||
! print '(10(F10.6,X))', delta_ij(i,1:N_det,1)
|
||||
! enddo
|
||||
end
|
||||
|
||||
@ -1,14 +1,17 @@
|
||||
subroutine mrcc_dress(i_generator,n_selected,det_buffer,Nint,iproc)
|
||||
subroutine mrcc_dress(delta_ij_sd_,Ndet_sd,i_generator,n_selected,det_buffer,Nint,iproc)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_generator,n_selected, Nint, iproc
|
||||
integer, intent(in) :: Ndet_sd
|
||||
double precision, intent(inout) :: delta_ij_sd_(Ndet_sd,Ndet_sd,*)
|
||||
|
||||
integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected)
|
||||
integer :: i,j,k
|
||||
integer :: i,j,k,m
|
||||
integer :: new_size
|
||||
logical :: is_in_wavefunction
|
||||
double precision :: degree(N_det_cas)
|
||||
integer :: idx(0:N_det_cas)
|
||||
integer :: degree(psi_det_size)
|
||||
integer :: idx(0:psi_det_size)
|
||||
logical :: good
|
||||
|
||||
integer(bit_kind) :: tq(Nint,2,n_selected)
|
||||
@ -17,7 +20,6 @@ subroutine mrcc_dress(i_generator,n_selected,det_buffer,Nint,iproc)
|
||||
|
||||
N_tq = 0
|
||||
do i=1,N_selected
|
||||
|
||||
c_ref = connected_to_ref(det_buffer(1,1,i),psi_generators,Nint, &
|
||||
i_generator,N_det_generators)
|
||||
|
||||
@ -46,9 +48,181 @@ subroutine mrcc_dress(i_generator,n_selected,det_buffer,Nint,iproc)
|
||||
endif
|
||||
enddo
|
||||
|
||||
print *, N_tq
|
||||
! Compute <k|H|a><a|H|j> / (E0 - Haa)
|
||||
double precision :: hka, haa
|
||||
double precision :: haj
|
||||
double precision :: f(N_states)
|
||||
|
||||
|
||||
! call i_h_j(psi_det(1,1,1), psi_det(1,1,64),Nint,hka)
|
||||
! call debug_det(psi_det(1,1,1), N_int)
|
||||
! call debug_det(psi_det(1,1,64), N_int)
|
||||
double precision :: phase
|
||||
integer :: exc(0:2,2,2)
|
||||
! call get_excitation(psi_det(1,1,1),psi_det(1,1,64),exc,degree(1),phase,Nint)
|
||||
integer :: h1, p1, h2, p2, s1, s2
|
||||
! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
! print *, hka
|
||||
! print *, h1, p1, h2, p2
|
||||
! print *, s1, s2
|
||||
! pause
|
||||
|
||||
|
||||
|
||||
do i=1,N_tq
|
||||
call debug_det(det_buffer(1,1,i),Nint)
|
||||
call get_excitation_degree_vector(psi_sd,tq(1,1,i),degree,Nint,Ndet_sd,idx)
|
||||
call i_h_j(tq(1,1,i),tq(1,1,i),Nint,haa)
|
||||
do m=1,N_states
|
||||
f(m) = 1.d0/(ci_electronic_energy(m)-haa)
|
||||
enddo
|
||||
do k=1,idx(0)
|
||||
call i_h_j(tq(1,1,i),psi_sd(1,1,idx(k)),Nint,hka)
|
||||
do j=k,idx(0)
|
||||
call i_h_j(tq(1,1,i),psi_sd(1,1,idx(j)),Nint,haj)
|
||||
do m=1,N_states
|
||||
delta_ij_sd_(idx(k), idx(j),m) += haj*hka* f(m)
|
||||
delta_ij_sd_(idx(j), idx(k),m) += haj*hka* f(m)
|
||||
enddo
|
||||
call get_excitation(tq(1,1,i),psi_sd(1,1,idx(j)),exc,degree(1),phase,Nint)
|
||||
call decode_exc(exc,degree(1),h1,p1,h2,p2,s1,s2)
|
||||
if ( (h1 == 1).and. &
|
||||
(p1 == 6).and. &
|
||||
(h2 == 1).and. &
|
||||
(p2 == 6).and. &
|
||||
(s1 == 1).and. &
|
||||
(s2 == 2) ) then
|
||||
call debug_det(tq(1,1,i), N_int)
|
||||
call debug_det(psi_sd(1,1,idx(j)), N_int)
|
||||
print *, haj
|
||||
pause
|
||||
endif
|
||||
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
end
|
||||
|
||||
BEGIN_PROVIDER [ double precision, delta_ij_sd, (N_det_sd, N_det_sd,N_states) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Dressing matrix in SD basis
|
||||
END_DOC
|
||||
delta_ij_sd = 0.d0
|
||||
call H_apply_mrcc(delta_ij_sd,N_det_sd)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, delta_ij, (N_det,N_det,N_states) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Dressing matrix in N_det basis
|
||||
END_DOC
|
||||
integer :: i,j,m
|
||||
delta_ij = 0.d0
|
||||
do m=1,N_states
|
||||
do j=1,N_det_sd
|
||||
do i=1,N_det_sd
|
||||
delta_ij(idx_sd(i),idx_sd(j),m) = delta_ij_sd(i,j,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Dressed H with Delta_ij
|
||||
END_DOC
|
||||
integer :: i, j
|
||||
do j=1,N_det
|
||||
do i=1,N_det
|
||||
h_matrix_dressed(i,j) = h_matrix_all_dets(i,j) + delta_ij(i,j,1)
|
||||
if (i==j) then
|
||||
print *, i, delta_ij(i,j,1), h_matrix_all_dets(i,j)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, CI_electronic_energy_dressed, (N_states_diag) ]
|
||||
&BEGIN_PROVIDER [ double precision, CI_eigenvectors_dressed, (N_det,N_states_diag) ]
|
||||
&BEGIN_PROVIDER [ double precision, CI_eigenvectors_s2_dressed, (N_states_diag) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Eigenvectors/values of the CI matrix
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
|
||||
do j=1,N_states_diag
|
||||
do i=1,N_det
|
||||
CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (diag_algorithm == "Davidson") then
|
||||
|
||||
stop 'use Lapack'
|
||||
! call davidson_diag(psi_det,CI_eigenvectors_dressed,CI_electronic_energy_dressed, &
|
||||
! size(CI_eigenvectors_dressed,1),N_det,N_states_diag,N_int,output_Dets)
|
||||
|
||||
else if (diag_algorithm == "Lapack") then
|
||||
|
||||
double precision, allocatable :: eigenvectors(:,:), eigenvalues(:)
|
||||
allocate (eigenvectors(size(H_matrix_dressed,1),N_det))
|
||||
allocate (eigenvalues(N_det))
|
||||
call lapack_diag(eigenvalues,eigenvectors, &
|
||||
H_matrix_dressed,size(H_matrix_dressed,1),N_det)
|
||||
CI_electronic_energy_dressed(:) = 0.d0
|
||||
do i=1,N_det
|
||||
CI_eigenvectors_dressed(i,1) = eigenvectors(i,1)
|
||||
enddo
|
||||
integer :: i_state
|
||||
double precision :: s2
|
||||
i_state = 0
|
||||
do j=1,N_det
|
||||
call get_s2_u0(psi_det,eigenvectors(1,j),N_det,N_det,s2)
|
||||
if(dabs(s2-expected_s2).le.0.3d0)then
|
||||
i_state += 1
|
||||
do i=1,N_det
|
||||
CI_eigenvectors_dressed(i,i_state) = eigenvectors(i,j)
|
||||
enddo
|
||||
CI_electronic_energy_dressed(i_state) = eigenvalues(j)
|
||||
CI_eigenvectors_s2_dressed(i_state) = s2
|
||||
endif
|
||||
if (i_state.ge.N_states_diag) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
! if(i_state < min(N_states_diag,N_det))then
|
||||
! print *, 'pb with the number of states'
|
||||
! print *, 'i_state = ',i_state
|
||||
! print *, 'N_states_diag ',N_states_diag
|
||||
! print *,'stopping ...'
|
||||
! stop
|
||||
! endif
|
||||
deallocate(eigenvectors,eigenvalues)
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! N_states lowest eigenvalues of the dressed CI matrix
|
||||
END_DOC
|
||||
|
||||
integer :: j
|
||||
character*(8) :: st
|
||||
call write_time(output_Dets)
|
||||
do j=1,N_states_diag
|
||||
CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion
|
||||
write(st,'(I4)') j
|
||||
call write_double(output_Dets,CI_energy(j),'Energy of state '//trim(st))
|
||||
call write_double(output_Dets,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -1,31 +1,117 @@
|
||||
use bitmasks
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_cas, (N_int,2,N_det_generators) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_cas_coefs, (N_det_generators,n_states) ]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), psi_sd, (N_int,2,N_det) ]
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmasks for CAS reference determinants. (N_int, alpha/beta, CAS reference)
|
||||
END_DOC
|
||||
logical :: exists
|
||||
integer :: i
|
||||
PROVIDE ezfio_filename
|
||||
|
||||
call ezfio_has_bitmasks_cas(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_cas(cas_bitmask)
|
||||
else
|
||||
do i=1,N_cas_bitmask
|
||||
cas_bitmask(:,:,i) = iand(not(HF_bitmask(:,:)),full_ijkl_bitmask(:,:))
|
||||
enddo
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, N_det_cas ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of generator detetrminants
|
||||
END_DOC
|
||||
integer :: i,k,l
|
||||
logical :: good
|
||||
call write_time(output_dets)
|
||||
N_det_cas = 0
|
||||
do i=1,N_det
|
||||
do l=1,n_cas_bitmask
|
||||
good = .True.
|
||||
do k=1,N_int
|
||||
good = good .and. ( &
|
||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,i)) == &
|
||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,1)) ) .and. ( &
|
||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,i)) == &
|
||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,1)) )
|
||||
enddo
|
||||
if (good) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (good) then
|
||||
N_det_cas += 1
|
||||
endif
|
||||
enddo
|
||||
N_det_cas = max(N_det_cas, 1)
|
||||
call write_int(output_dets,N_det_cas, 'Number of determinants in the CAS')
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_cas, (N_int,2,N_det_cas) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_cas_coefs, (N_det_cas,n_states) ]
|
||||
&BEGIN_PROVIDER [ integer, idx_cas, (N_det_cas) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! For Single reference wave functions, the generator is the
|
||||
! Hartree-Fock determinant
|
||||
END_DOC
|
||||
integer :: i, k, l, m
|
||||
logical :: good
|
||||
m=0
|
||||
do i=1,N_det
|
||||
do l=1,n_cas_bitmask
|
||||
good = .True.
|
||||
do k=1,N_int
|
||||
good = good .and. ( &
|
||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,i)) == &
|
||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,1)) ) .and. ( &
|
||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,i)) == &
|
||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,1)) )
|
||||
enddo
|
||||
if (good) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (good) then
|
||||
m = m+1
|
||||
do k=1,N_int
|
||||
psi_cas(k,1,m) = psi_det(k,1,i)
|
||||
psi_cas(k,2,m) = psi_det(k,2,i)
|
||||
enddo
|
||||
idx_cas(m) = i
|
||||
do k=1,N_states
|
||||
psi_cas_coefs(m,k) = psi_coef(i,k)
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_sd, (N_int,2,N_det) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_sd_coefs, (N_det,n_states) ]
|
||||
&BEGIN_PROVIDER [ integer, idx_cas, (N_det_generators) ]
|
||||
&BEGIN_PROVIDER [ integer, idx_sd, (N_det) ]
|
||||
&BEGIN_PROVIDER [ integer, N_det_sd]
|
||||
&BEGIN_PROVIDER [ integer, N_det_cas]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! SD
|
||||
END_DOC
|
||||
integer :: i_cas,i_sd,j,k
|
||||
integer :: i_sd,j,k
|
||||
integer :: degree
|
||||
logical :: in_cas
|
||||
i_cas=0
|
||||
i_sd =0
|
||||
do k=1,N_det
|
||||
in_cas = .False.
|
||||
do j=1,n_det_generators
|
||||
call get_excitation_degree(psi_generators(1,1,j), psi_det(1,1,k), degree, N_int)
|
||||
do j=1,N_det_cas
|
||||
call get_excitation_degree(psi_cas(1,1,j), psi_det(1,1,k), degree, N_int)
|
||||
if (degree == 0) then
|
||||
i_cas += 1
|
||||
psi_cas(1:N_int,1:2,i_cas) = psi_det(1:N_int,1:2,k)
|
||||
psi_cas_coefs(i_cas,1:N_states) = psi_coef(k,1:N_states)
|
||||
in_cas = .True.
|
||||
idx_cas(i_cas) = k
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
@ -38,7 +124,6 @@
|
||||
endif
|
||||
enddo
|
||||
N_det_sd = i_sd
|
||||
N_det_cas = i_cas
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, lambda_mrcc, (psi_det_size,n_states) ]
|
||||
@ -63,15 +148,3 @@ BEGIN_PROVIDER [ double precision, lambda_mrcc, (psi_det_size,n_states) ]
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
subroutine update_generators
|
||||
implicit none
|
||||
integer :: i,j,k
|
||||
n_det_generators = N_det_sd
|
||||
do k=1,N_det_sd
|
||||
do j=1,2
|
||||
do i=1,N_int
|
||||
psi_generators(i,j,k) = psi_sd(i,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
end
|
||||
|
||||
@ -1 +1 @@
|
||||
AOs BiInts Bitmask CID CID_SC2_selected CID_selected CIS CISD CISD_selected CISD_SC2_selected Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs MP2 Nuclei Output Selectors_full Utils Molden FCIdump Generators_CAS CAS_SD_selected DDCI_selected
|
||||
AOs BiInts Bitmask CID CID_SC2_selected CID_selected CIS CISD CISD_selected CISD_SC2_selected Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs MP2 Nuclei Output Selectors_full Utils Molden FCIdump Generators_CAS CAS_SD_selected DDCI_selected MRCC
|
||||
|
||||
Loading…
Reference in New Issue
Block a user