mirror of
https://github.com/LCPQ/quantum_package
synced 2024-10-19 22:41:48 +02:00
fixed rs_ks_scf density
This commit is contained in:
parent
2425201c81
commit
e327757118
@ -12,6 +12,9 @@ BEGIN_PROVIDER [double precision, one_body_dm_mo_alpha_for_dft, (mo_num,mo_num,
|
||||
else if (density_for_dft .EQ. "WFT")then
|
||||
provide mo_coef
|
||||
one_body_dm_mo_alpha_for_dft = one_body_dm_mo_alpha
|
||||
else if (density_for_dft .EQ. "KS")then
|
||||
provide mo_coef
|
||||
one_body_dm_mo_alpha_for_dft = one_body_dm_mo_alpha_one_det
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
@ -30,6 +33,9 @@ BEGIN_PROVIDER [double precision, one_body_dm_mo_beta_for_dft, (mo_num,mo_num, N
|
||||
else if (density_for_dft .EQ. "WFT")then
|
||||
provide mo_coef
|
||||
one_body_dm_mo_beta_for_dft = one_body_dm_mo_beta
|
||||
else if (density_for_dft .EQ. "KS")then
|
||||
provide mo_coef
|
||||
one_body_dm_mo_beta_for_dft = one_body_dm_mo_beta_one_det
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
@ -53,25 +59,37 @@ END_PROVIDER
|
||||
! one body density matrix on the AO basis based on one_body_dm_mo_alpha_for_dft
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,istate
|
||||
integer :: istate
|
||||
double precision :: mo_alpha,mo_beta
|
||||
|
||||
one_body_dm_alpha_ao_for_dft = 0.d0
|
||||
one_body_dm_beta_ao_for_dft = 0.d0
|
||||
do k = 1, ao_num
|
||||
do l = 1, ao_num
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do istate = 1, N_states
|
||||
mo_alpha = one_body_dm_mo_alpha_for_dft(j,i,istate)
|
||||
mo_beta = one_body_dm_mo_beta_for_dft(j,i,istate)
|
||||
one_body_dm_alpha_ao_for_dft(l,k,istate) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha
|
||||
one_body_dm_beta_ao_for_dft(l,k,istate) += mo_coef(k,i) * mo_coef(l,j) * mo_beta
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
do istate = 1, N_states
|
||||
call mo_to_ao_no_overlap( one_body_dm_mo_alpha_for_dft(1,1,istate), &
|
||||
size(one_body_dm_mo_alpha_for_dft,1), &
|
||||
one_body_dm_alpha_ao_for_dft(1,1,istate), &
|
||||
size(one_body_dm_alpha_ao_for_dft,1) )
|
||||
call mo_to_ao_no_overlap( one_body_dm_mo_beta_for_dft(1,1,istate), &
|
||||
size(one_body_dm_mo_beta_for_dft,1), &
|
||||
one_body_dm_beta_ao_for_dft(1,1,istate), &
|
||||
size(one_body_dm_beta_ao_for_dft,1) )
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, one_body_dm_mo_alpha_one_det, (mo_num,mo_num, N_states)]
|
||||
&BEGIN_PROVIDER [double precision, one_body_dm_mo_beta_one_det, (mo_num,mo_num, N_states)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! One body density matrix on the |MO| basis for a single determinant
|
||||
END_DOC
|
||||
integer :: i
|
||||
one_body_dm_mo_alpha_one_det = 0.d0
|
||||
one_body_dm_mo_beta_one_det = 0.d0
|
||||
do i =1, elec_alpha_num
|
||||
one_body_dm_mo_alpha_one_det(i,i, 1:N_states) = 1.d0
|
||||
enddo
|
||||
do i =1, elec_beta_num
|
||||
one_body_dm_mo_beta_one_det(i,i, 1:N_states) = 1.d0
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
@ -231,89 +231,6 @@ END_PROVIDER
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, one_body_single_double_dm_mo_alpha, (mo_num,mo_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, one_body_single_double_dm_mo_beta, (mo_num,mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! $\alpha$ and $\beta$ one-body density matrix for each state
|
||||
END_DOC
|
||||
|
||||
integer :: j,k,l,m
|
||||
integer :: occ(N_int*bit_kind_size,2)
|
||||
double precision :: ck, cl, ckl
|
||||
double precision :: phase
|
||||
integer :: h1,h2,p1,p2,s1,s2, degree
|
||||
integer :: exc(0:2,2,2),n_occ_alpha
|
||||
double precision, allocatable :: tmp_a(:,:), tmp_b(:,:)
|
||||
integer :: degree_respect_to_HF_k
|
||||
integer :: degree_respect_to_HF_l
|
||||
|
||||
PROVIDE elec_alpha_num elec_beta_num
|
||||
|
||||
one_body_single_double_dm_mo_alpha = 0.d0
|
||||
one_body_single_double_dm_mo_beta = 0.d0
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc,&
|
||||
!$OMP tmp_a, tmp_b, n_occ_alpha,degree_respect_to_HF_k,degree_respect_to_HF_l)&
|
||||
!$OMP SHARED(ref_bitmask,psi_det,psi_coef,N_int,N_states,state_average_weight,elec_alpha_num,&
|
||||
!$OMP elec_beta_num,one_body_single_double_dm_mo_alpha,one_body_single_double_dm_mo_beta,N_det,&
|
||||
!$OMP mo_num)
|
||||
allocate(tmp_a(mo_num,mo_num), tmp_b(mo_num,mo_num) )
|
||||
tmp_a = 0.d0
|
||||
tmp_b = 0.d0
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do k=1,N_det
|
||||
call bitstring_to_list(psi_det(1,1,k), occ(1,1), n_occ_alpha, N_int)
|
||||
call bitstring_to_list(psi_det(1,2,k), occ(1,2), n_occ_alpha, N_int)
|
||||
call get_excitation_degree(ref_bitmask,psi_det(1,1,k),degree_respect_to_HF_k,N_int)
|
||||
|
||||
do m=1,N_states
|
||||
ck = psi_coef(k,m)*psi_coef(k,m) * state_average_weight(m)
|
||||
call get_excitation_degree(ref_bitmask,psi_det(1,1,k),degree_respect_to_HF_l,N_int)
|
||||
if(degree_respect_to_HF_l.le.0)then
|
||||
do l=1,elec_alpha_num
|
||||
j = occ(l,1)
|
||||
tmp_a(j,j) += ck
|
||||
enddo
|
||||
do l=1,elec_beta_num
|
||||
j = occ(l,2)
|
||||
tmp_b(j,j) += ck
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
do l=1,k-1
|
||||
call get_excitation_degree(ref_bitmask,psi_det(1,1,l),degree_respect_to_HF_l,N_int)
|
||||
if(degree_respect_to_HF_k.ne.0)cycle
|
||||
if(degree_respect_to_HF_l.eq.2.and.degree_respect_to_HF_k.ne.2)cycle
|
||||
call get_excitation_degree(psi_det(1,1,k),psi_det(1,1,l),degree,N_int)
|
||||
if (degree /= 1) then
|
||||
cycle
|
||||
endif
|
||||
call get_mono_excitation(psi_det(1,1,k),psi_det(1,1,l),exc,phase,N_int)
|
||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
do m=1,N_states
|
||||
ckl = psi_coef(k,m) * psi_coef(l,m) * phase * state_average_weight(m)
|
||||
if (s1==1) then
|
||||
tmp_a(h1,p1) += ckl
|
||||
tmp_a(p1,h1) += ckl
|
||||
else
|
||||
tmp_b(h1,p1) += ckl
|
||||
tmp_b(p1,h1) += ckl
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
!$OMP CRITICAL
|
||||
one_body_single_double_dm_mo_alpha = one_body_single_double_dm_mo_alpha + tmp_a
|
||||
!$OMP END CRITICAL
|
||||
!$OMP CRITICAL
|
||||
one_body_single_double_dm_mo_beta = one_body_single_double_dm_mo_beta + tmp_b
|
||||
!$OMP END CRITICAL
|
||||
deallocate(tmp_a,tmp_b)
|
||||
!$OMP END PARALLEL
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo, (mo_num,mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
@ -10,10 +10,8 @@ program srs_ks_cf
|
||||
touch io_mo_one_e_integrals
|
||||
io_ao_one_e_integrals = "None"
|
||||
touch io_ao_one_e_integrals
|
||||
read_wf = .False.
|
||||
density_for_dft ="WFT"
|
||||
density_for_dft ="KS"
|
||||
touch density_for_dft
|
||||
touch read_wf
|
||||
print*, '**************************'
|
||||
print*, 'mu_erf_dft = ',mu_erf_dft
|
||||
print*, '**************************'
|
||||
|
@ -12,9 +12,8 @@ program rs_ks_scf
|
||||
touch io_ao_one_e_integrals
|
||||
|
||||
read_wf = .False.
|
||||
density_for_dft ="WFT"
|
||||
density_for_dft ="KS"
|
||||
touch density_for_dft
|
||||
touch read_wf
|
||||
print*, '**************************'
|
||||
print*, 'mu_erf_dft = ',mu_erf_dft
|
||||
print*, '**************************'
|
||||
|
@ -3,7 +3,7 @@ subroutine mo_to_ao(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||
BEGIN_DOC
|
||||
! Transform A from the MO basis to the AO basis
|
||||
!
|
||||
! (S.C).A_mo.(S.C)t
|
||||
! $(S.C).A_{mo}.(S.C)^\dagger$
|
||||
END_DOC
|
||||
integer, intent(in) :: LDA_ao,LDA_mo
|
||||
double precision, intent(in) :: A_mo(LDA_mo,mo_num)
|
||||
@ -25,6 +25,31 @@ subroutine mo_to_ao(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||
deallocate(T)
|
||||
end
|
||||
|
||||
subroutine mo_to_ao_no_overlap(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! $C.A_{mo}.C^\dagger$
|
||||
END_DOC
|
||||
integer, intent(in) :: LDA_ao,LDA_mo
|
||||
double precision, intent(in) :: A_mo(LDA_mo,mo_num)
|
||||
double precision, intent(out) :: A_ao(LDA_ao,ao_num)
|
||||
double precision, allocatable :: T(:,:)
|
||||
|
||||
allocate ( T(mo_num,ao_num) )
|
||||
|
||||
call dgemm('N','T', mo_num, ao_num, mo_num, &
|
||||
1.d0, A_mo,size(A_mo,1), &
|
||||
mo_coef, size(mo_coef,1), &
|
||||
0.d0, T, size(T,1))
|
||||
|
||||
call dgemm('N','N', ao_num, ao_num, mo_num, &
|
||||
1.d0, mo_coef, size(mo_coef,1), &
|
||||
T, size(T,1), &
|
||||
0.d0, A_ao, size(A_ao,1))
|
||||
|
||||
deallocate(T)
|
||||
end
|
||||
|
||||
BEGIN_PROVIDER [ double precision, S_mo_coef, (ao_num, mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
Loading…
Reference in New Issue
Block a user