mirror of
https://gitlab.com/scemama/eplf
synced 2024-10-31 19:23:55 +01:00
Checkpoint of density matrices
This commit is contained in:
parent
fdaaa4cfe0
commit
d4607cc3f9
@ -41,6 +41,12 @@ grid
|
|||||||
num_y integer = at(grid_point_num,2)
|
num_y integer = at(grid_point_num,2)
|
||||||
num_z integer = at(grid_point_num,3)
|
num_z integer = at(grid_point_num,3)
|
||||||
|
|
||||||
|
density_matrix
|
||||||
|
one real (mo_basis_mo_active_num,mo_basis_mo_active_num,2)
|
||||||
|
two_num integer
|
||||||
|
two_indice real (4,density_matrix_two_num)
|
||||||
|
two_value real (2,density_matrix_two_num)
|
||||||
|
|
||||||
grid_data
|
grid_data
|
||||||
eplf real (grid_num_x,grid_num_y,grid_num_z)
|
eplf real (grid_num_x,grid_num_y,grid_num_z)
|
||||||
eplf_grad real (grid_num_x,grid_num_y,grid_num_z,4)
|
eplf_grad real (grid_num_x,grid_num_y,grid_num_z,4)
|
||||||
|
@ -37,10 +37,10 @@ BEGIN_PROVIDER [ real, density_alpha_value_p ]
|
|||||||
density_alpha_value_p += mo_value_p(i)**2
|
density_alpha_value_p += mo_value_p(i)**2
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do m=1,one_e_density_num
|
do j=1,elec_alpha_num-mo_closed_num
|
||||||
i = one_e_density_indice(1,m)
|
do i=1,elec_alpha_num-mo_closed_num
|
||||||
j = one_e_density_indice(2,m)
|
density_alpha_value_p += mo_value_prod_p(i,j) * one_e_density_mo(i,j,1)
|
||||||
density_alpha_value_p += mo_value_prod_p(i,j) * one_e_density_value(1,m)
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
@ -52,17 +52,16 @@ BEGIN_PROVIDER [ real, density_beta_value_p ]
|
|||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
density_beta_value_p = 0.
|
density_beta_value_p = 0.
|
||||||
integer :: i
|
|
||||||
do i=1,mo_closed_num
|
do i=1,mo_closed_num
|
||||||
density_beta_value_p += mo_value_p(i)**2
|
density_beta_value_p += mo_value_p(i)**2
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do m=1,one_e_density_num
|
do j=1,elec_beta_num-mo_closed_num
|
||||||
i = one_e_density_indice(1,m)
|
do i=1,elec_beta_num-mo_closed_num
|
||||||
j = one_e_density_indice(2,m)
|
density_beta_value_p += mo_value_prod_p(i,j) * one_e_density_mo(i,j,2)
|
||||||
density_beta_value_p += mo_value_prod_p(i,j) * one_e_density_value(2,m)
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
221
src/det.irp.f
221
src/det.irp.f
@ -55,44 +55,41 @@ integer function det_exc(k,l,p)
|
|||||||
jmax = elec_num_2(p)-mo_closed_num
|
jmax = elec_num_2(p)-mo_closed_num
|
||||||
det_exc = 0
|
det_exc = 0
|
||||||
|
|
||||||
|
integer :: dl(mo_closed_num), dk(mo_closed_num), buffer(0:mo_closed_num)
|
||||||
do i=1,jmax
|
do i=1,jmax
|
||||||
logical :: found
|
dk(i) = det(i,k,p)
|
||||||
found = .False.
|
dl(i) = det(i,l,p)
|
||||||
do j=1,jmax
|
buffer(i) = dk(i)
|
||||||
if (det(j,l,p) == det(i,k,p)) then
|
|
||||||
found = .True.
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
if (.not.found) then
|
|
||||||
|
integer :: kmax
|
||||||
|
logical :: notfound
|
||||||
|
do i=1,jmax
|
||||||
|
notfound = .True.
|
||||||
|
do j=1,jmax
|
||||||
|
notfound = notfound .and. (dl(j) /= dk(i))
|
||||||
|
enddo
|
||||||
|
if (notfound) then
|
||||||
det_exc += 1
|
det_exc += 1
|
||||||
endif
|
endif
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
! Phase
|
! Phase
|
||||||
|
|
||||||
integer :: nperm
|
integer :: nperm
|
||||||
nperm = 0
|
nperm = 0
|
||||||
integer, allocatable, save :: buffer(:)
|
do i=1,jmax
|
||||||
if (.not. allocated(buffer)) then
|
if (buffer(i) /= dl(i)) then
|
||||||
allocate (buffer(0:mo_num-mo_closed_num))
|
|
||||||
endif
|
|
||||||
do i=1,elec_num_2(p)-mo_closed_num
|
|
||||||
buffer(i) = det(i,k,p)
|
|
||||||
enddo
|
|
||||||
do i=1,elec_num_2(p)-mo_closed_num
|
|
||||||
if (buffer(i) /= det(i,l,p)) then
|
|
||||||
integer :: m
|
integer :: m
|
||||||
m=elec_num_2(p)-mo_closed_num
|
m=jmax
|
||||||
do j=i+1,elec_num_2(p)-mo_closed_num
|
do j=i+1,jmax
|
||||||
if (buffer(i) == det(j,l,p)) then ! found
|
if (buffer(i) == dl(j)) then ! found
|
||||||
m=j
|
m=j
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
buffer(0) = buffer(i)
|
buffer(0) = buffer(i)
|
||||||
buffer(i) = det(m,l,p)
|
buffer(i) = dl(m)
|
||||||
buffer(m) = buffer(0)
|
buffer(m) = buffer(0)
|
||||||
nperm += m-i
|
nperm += m-i
|
||||||
endif
|
endif
|
||||||
@ -108,33 +105,37 @@ subroutine get_single_excitation(k,l,m,n,p)
|
|||||||
integer, intent(out) :: m, n ! m->n excitation
|
integer, intent(out) :: m, n ! m->n excitation
|
||||||
integer, intent(in) :: p ! spin
|
integer, intent(in) :: p ! spin
|
||||||
|
|
||||||
logical :: found
|
logical :: notfound
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
m=0
|
m=0
|
||||||
n=0
|
n=0
|
||||||
do j=1,elec_num_2(p)-mo_closed_num
|
|
||||||
found = .False.
|
integer :: dl(mo_closed_num), dk(mo_closed_num), buffer(0:mo_closed_num)
|
||||||
do i=1,elec_num_2(p)-mo_closed_num
|
integer :: jmax
|
||||||
if (det(j,k,p) == det(i,l,p)) then
|
jmax = elec_num_2(p)-mo_closed_num
|
||||||
found = .True.
|
|
||||||
exit
|
do i=1,jmax
|
||||||
endif
|
dk(i) = det(i,k,p)
|
||||||
|
dl(i) = det(i,l,p)
|
||||||
enddo
|
enddo
|
||||||
if (.not.found) then
|
|
||||||
m = det(j,k,p)
|
do j=1,jmax
|
||||||
|
notfound = .True.
|
||||||
|
do i=1,jmax
|
||||||
|
notfound = notfound .and. (dk(j) /= dl(i))
|
||||||
|
enddo
|
||||||
|
if (notfound) then
|
||||||
|
m = dk(j)
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i=1,elec_num_2(p)-mo_closed_num
|
do i=1,jmax
|
||||||
found = .False.
|
notfound = .True.
|
||||||
do j=1,elec_num_2(p)-mo_closed_num
|
do j=1,jmax
|
||||||
if (det(j,k,p) == det(i,l,p)) then
|
notfound = notfound .and. (dk(j) /= dl(i))
|
||||||
found = .True.
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
if (.not.found) then
|
if (notfound) then
|
||||||
n = det(i,l,p)
|
n = det(i,l,p)
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
@ -149,43 +150,47 @@ subroutine get_double_excitation(k,l,m,n,r,s,p)
|
|||||||
integer, intent(out) :: r, s ! r->s excitation
|
integer, intent(out) :: r, s ! r->s excitation
|
||||||
integer, intent(in) :: p ! spin
|
integer, intent(in) :: p ! spin
|
||||||
|
|
||||||
logical :: found
|
logical :: notfound
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
m=0
|
m=0
|
||||||
n=0
|
n=0
|
||||||
r=0
|
r=0
|
||||||
s=0
|
s=0
|
||||||
do j=1,elec_num_2(p)-mo_closed_num
|
|
||||||
found = .False.
|
integer :: dl(mo_closed_num), dk(mo_closed_num), buffer(0:mo_closed_num)
|
||||||
do i=1,elec_num_2(p)-mo_closed_num
|
integer :: jmax
|
||||||
if (det(j,k,p) == det(i,l,p)) then
|
jmax = elec_num_2(p)-mo_closed_num
|
||||||
found = .True.
|
|
||||||
exit
|
do i=1,jmax
|
||||||
endif
|
dk(i) = det(i,k,p)
|
||||||
|
dl(i) = det(i,l,p)
|
||||||
enddo
|
enddo
|
||||||
if (.not.found) then
|
|
||||||
|
do j=1,jmax
|
||||||
|
notfound = .True.
|
||||||
|
do i=1,jmax
|
||||||
|
notfound = notfound .and. (dk(j) /= dl(i))
|
||||||
|
enddo
|
||||||
|
if (notfound) then
|
||||||
if (m == 0) then
|
if (m == 0) then
|
||||||
m = det(j,k,p)
|
m = dk(j)
|
||||||
else
|
else
|
||||||
r = det(j,k,p)
|
r = dk(j)
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i=1,elec_num_2(p)-mo_closed_num
|
do j=1,jmax
|
||||||
found = .False.
|
notfound = .True.
|
||||||
do j=1,elec_num_2(p)-mo_closed_num
|
do i=1,jmax
|
||||||
if (det(j,k,p) == det(i,l,p)) then
|
notfound = notfound .and. (dk(j) /= dl(i))
|
||||||
found = .True.
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
if (.not.found) then
|
if (notfound) then
|
||||||
if (n == 0) then
|
if (n == 0) then
|
||||||
n = det(i,l,p)
|
n = dl(j)
|
||||||
else
|
else
|
||||||
s = det(i,l,p)
|
s = dl(j)
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
@ -193,72 +198,6 @@ subroutine get_double_excitation(k,l,m,n,r,s,p)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
BEGIN_PROVIDER [ real, ci_mo, (mo_num,mo_num,3) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Spin Density matrix in the AO basis
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,k,l,m,ispin, ik,il
|
|
||||||
do ispin=1,3
|
|
||||||
|
|
||||||
do j=1,mo_num
|
|
||||||
do i=1,mo_num
|
|
||||||
ci_mo(i,j,ispin) = 0.
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do l=1,det_num
|
|
||||||
do m=1,det_num
|
|
||||||
real :: factor
|
|
||||||
factor = 2.*det_coef(l)*det_coef(m)
|
|
||||||
do il=1,mo_closed_num
|
|
||||||
do ik=1,mo_closed_num
|
|
||||||
ci_mo(ik,il,ispin) += factor
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
|
||||||
do l=1,det_num
|
|
||||||
do m=1,det_num
|
|
||||||
factor = det_coef(l)*det_coef(m)
|
|
||||||
do ispin=1,2
|
|
||||||
do j=mo_closed_num+1,elec_num_2(ispin)
|
|
||||||
ik = det(j-mo_closed_num,l,ispin)
|
|
||||||
do il=1,mo_closed_num
|
|
||||||
ci_mo(ik,il,ispin) += factor
|
|
||||||
ci_mo(il,ik,ispin) += factor
|
|
||||||
enddo
|
|
||||||
do i=mo_closed_num+1,elec_num_2(ispin)
|
|
||||||
il = det(i-mo_closed_num,m,ispin)
|
|
||||||
ci_mo(ik,il,ispin) += factor
|
|
||||||
ci_mo(il,ik,ispin) += factor
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
ispin=3
|
|
||||||
do j=mo_closed_num+1,elec_num_2(1)
|
|
||||||
ik = det(j-mo_closed_num,l,1)
|
|
||||||
do il=1,mo_closed_num
|
|
||||||
ci_mo(ik,il,ispin) += det_coef(l)*det_coef(m)
|
|
||||||
ci_mo(il,ik,ispin) += det_coef(l)*det_coef(m)
|
|
||||||
enddo
|
|
||||||
do i=mo_closed_num+1,elec_num_2(2)
|
|
||||||
il = det(i-mo_closed_num,m,2)
|
|
||||||
ci_mo(ik,il,ispin) += det_coef(l)*det_coef(m)
|
|
||||||
ci_mo(il,ik,ispin) += det_coef(l)*det_coef(m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, two_e_density_num_max ]
|
BEGIN_PROVIDER [ integer, two_e_density_num_max ]
|
||||||
implicit none
|
implicit none
|
||||||
@ -266,8 +205,13 @@ BEGIN_PROVIDER [ integer, two_e_density_num_max ]
|
|||||||
! Number of factors containing the Slater rules
|
! Number of factors containing the Slater rules
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
two_e_density_num_max = 2*mo_num
|
two_e_density_num_max = 0
|
||||||
|
call get_density_matrix_two_num(two_e_density_num_max)
|
||||||
|
if (two_e_density_num_max /= 0) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
two_e_density_num_max = 2*mo_num
|
||||||
integer :: k,l
|
integer :: k,l
|
||||||
integer :: exc(3), nact, nact2, p, p2
|
integer :: exc(3), nact, nact2, p, p2
|
||||||
integer :: det_exc
|
integer :: det_exc
|
||||||
@ -295,6 +239,7 @@ BEGIN_PROVIDER [ integer, two_e_density_num_max ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
call set_density_matrix_two_num(two_e_density_num_max)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, two_e_density_indice, (4,two_e_density_num_max) ]
|
BEGIN_PROVIDER [ integer, two_e_density_indice, (4,two_e_density_num_max) ]
|
||||||
@ -305,6 +250,13 @@ END_PROVIDER
|
|||||||
! Compact representation of eplf factors
|
! Compact representation of eplf factors
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
|
two_e_density_indice(1,1) = -1
|
||||||
|
call get_density_matrix_two_indice(two_e_density_indice)
|
||||||
|
call get_density_matrix_two_value(two_e_density_value)
|
||||||
|
if (two_e_density_indice(1,1) /= -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
integer :: i,j,k,l,m
|
integer :: i,j,k,l,m
|
||||||
|
|
||||||
integer :: n,p,p2,q
|
integer :: n,p,p2,q
|
||||||
@ -509,6 +461,10 @@ END_SHELL
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
call set_density_matrix_two_indice(two_e_density_indice)
|
||||||
|
call set_density_matrix_two_value(two_e_density_value)
|
||||||
|
call set_density_matrix_two_num(two_e_density_num)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ real, one_e_density_mo, (mo_active_num,mo_active_num,2) ]
|
BEGIN_PROVIDER [ real, one_e_density_mo, (mo_active_num,mo_active_num,2) ]
|
||||||
@ -517,6 +473,13 @@ BEGIN_PROVIDER [ real, one_e_density_mo, (mo_active_num,mo_active_num,2) ]
|
|||||||
! One electron spin density matrix in MO space
|
! One electron spin density matrix in MO space
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k,l,p, il, jl
|
integer :: i,j,k,l,p, il, jl
|
||||||
|
|
||||||
|
one_e_density_mo(1,1,1) = -1.
|
||||||
|
call get_density_matrix_one(one_e_density_mo)
|
||||||
|
if (one_e_density_mo(1,1,1) /= -1.) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
do p=1,2
|
do p=1,2
|
||||||
do i=1,mo_active_num
|
do i=1,mo_active_num
|
||||||
do j=1,mo_active_num
|
do j=1,mo_active_num
|
||||||
@ -554,4 +517,6 @@ BEGIN_PROVIDER [ real, one_e_density_mo, (mo_active_num,mo_active_num,2) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
call set_density_matrix_one(one_e_density_mo)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -45,6 +45,10 @@ data = [ \
|
|||||||
("grid_data_elf_partition" , "real" , "(grid_x_num,grid_y_num,grid_z_num)" ),
|
("grid_data_elf_partition" , "real" , "(grid_x_num,grid_y_num,grid_z_num)" ),
|
||||||
("grid_data_eplf_partition" , "real" , "(grid_x_num,grid_y_num,grid_z_num)" ),
|
("grid_data_eplf_partition" , "real" , "(grid_x_num,grid_y_num,grid_z_num)" ),
|
||||||
("grid_data_density_partition" , "real" , "(grid_x_num,grid_y_num,grid_z_num)" ),
|
("grid_data_density_partition" , "real" , "(grid_x_num,grid_y_num,grid_z_num)" ),
|
||||||
|
("density_matrix_one" , "real" , "(mo_active_num,mo_active_num,2)" ),
|
||||||
|
("density_matrix_two_num" , "integer" , "" ),
|
||||||
|
("density_matrix_two_indice" , "real" , "(4,two_e_density_num_max)" ),
|
||||||
|
("density_matrix_two_value" , "real" , "(2,two_e_density_num_max)" ),
|
||||||
]
|
]
|
||||||
|
|
||||||
data_no_set = [\
|
data_no_set = [\
|
||||||
|
Loading…
Reference in New Issue
Block a user