mirror of https://gitlab.com/scemama/eplf
253 lines
6.4 KiB
Fortran
253 lines
6.4 KiB
Fortran
BEGIN_PROVIDER [ real, density_value_p ]
|
|
|
|
BEGIN_DOC
|
|
! Value of the density_value at the current point
|
|
END_DOC
|
|
|
|
integer :: i
|
|
density_value_p = density_alpha_value_p + density_beta_value_p
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, density_grad_p, (3) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Gradient of the density at the current point
|
|
END_DOC
|
|
|
|
density_grad_p(1) = density_alpha_grad_p(1) + density_beta_grad_p(1)
|
|
density_grad_p(2) = density_alpha_grad_p(2) + density_beta_grad_p(2)
|
|
density_grad_p(3) = density_alpha_grad_p(3) + density_beta_grad_p(3)
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ real, density_alpha_value_p ]
|
|
|
|
BEGIN_DOC
|
|
! Value of the alpha density at the current point
|
|
END_DOC
|
|
|
|
integer :: i
|
|
|
|
density_alpha_value_p = 0.
|
|
|
|
do i=1,mo_closed_num
|
|
density_alpha_value_p += mo_value_p(i)*mo_value_p(i)
|
|
enddo
|
|
|
|
do j=1,elec_alpha_num-mo_closed_num
|
|
do i=1,elec_alpha_num-mo_closed_num
|
|
density_alpha_value_p += mo_value_prod_p(i+mo_closed_num,j+mo_closed_num) * one_e_density_mo(i,j,1)
|
|
enddo
|
|
enddo
|
|
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ real, density_beta_value_p ]
|
|
|
|
BEGIN_DOC
|
|
! Value of the beta density at the current point
|
|
END_DOC
|
|
|
|
density_beta_value_p = 0.
|
|
|
|
do i=1,mo_closed_num
|
|
density_beta_value_p += mo_value_p(i)*mo_value_p(i)
|
|
enddo
|
|
|
|
do j=1,elec_beta_num-mo_closed_num
|
|
do i=1,elec_beta_num-mo_closed_num
|
|
density_beta_value_p += mo_value_prod_p(i+mo_closed_num,j+mo_closed_num) * one_e_density_mo(i,j,2)
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, density_alpha_grad_p, (3) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Gradient of the density at the current point
|
|
END_DOC
|
|
|
|
integer :: i
|
|
|
|
density_alpha_grad_p(1) = 0.
|
|
density_alpha_grad_p(2) = 0.
|
|
density_alpha_grad_p(3) = 0.
|
|
|
|
do i=1,mo_closed_num
|
|
density_alpha_grad_p(1) += 2.*mo_grad_p(i,1)*mo_value_p(i)
|
|
density_alpha_grad_p(2) += 2.*mo_grad_p(i,2)*mo_value_p(i)
|
|
density_alpha_grad_p(3) += 2.*mo_grad_p(i,3)*mo_value_p(i)
|
|
enddo
|
|
|
|
! TODO Faux !! => Regles de Slater
|
|
integer :: k,j,l
|
|
real :: buffer(3)
|
|
if (det_num > 1) then
|
|
call abrt(irp_here,'Need to implement Slater rules for gradient')
|
|
endif
|
|
do k=1,det_num
|
|
do l=1,det_num
|
|
buffer(1) = 0.
|
|
buffer(2) = 0.
|
|
buffer(3) = 0.
|
|
do i=1,mo_active_num
|
|
buffer(1) += mo_grad_p(det(i,k,1),1)*mo_value_p(det(i,l,1)) &
|
|
+ mo_grad_p(det(i,l,1),1)*mo_value_p(det(i,k,1))
|
|
buffer(2) += mo_grad_p(det(i,k,1),2)*mo_value_p(det(i,l,1)) &
|
|
+ mo_grad_p(det(i,l,1),2)*mo_value_p(det(i,k,1))
|
|
buffer(3) += mo_grad_p(det(i,k,1),3)*mo_value_p(det(i,l,1)) &
|
|
+ mo_grad_p(det(i,l,1),3)*mo_value_p(det(i,k,1))
|
|
enddo
|
|
density_alpha_grad_p(1) += det_coef(k)*det_coef(l)*buffer(1)
|
|
density_alpha_grad_p(2) += det_coef(k)*det_coef(l)*buffer(2)
|
|
density_alpha_grad_p(3) += det_coef(k)*det_coef(l)*buffer(3)
|
|
enddo
|
|
enddo
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, density_beta_grad_p, (3) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Gradient of the density at the current point
|
|
END_DOC
|
|
|
|
integer :: i
|
|
|
|
density_beta_grad_p(1) = 0.
|
|
density_beta_grad_p(2) = 0.
|
|
density_beta_grad_p(3) = 0.
|
|
|
|
do i=1,mo_closed_num
|
|
density_beta_grad_p(1) += 2.*mo_grad_p(i,1)*mo_value_p(i)
|
|
density_beta_grad_p(2) += 2.*mo_grad_p(i,2)*mo_value_p(i)
|
|
density_beta_grad_p(3) += 2.*mo_grad_p(i,3)*mo_value_p(i)
|
|
enddo
|
|
|
|
! TODO vectorization
|
|
if (det_num > 1) then
|
|
call abrt(irp_here,'Need to implement Slater rules for gradient')
|
|
endif
|
|
integer :: k,j,l
|
|
real :: buffer(3)
|
|
do k=1,det_num
|
|
do l=1,det_num
|
|
buffer(1) = 0.
|
|
buffer(2) = 0.
|
|
buffer(3) = 0.
|
|
do i=1,mo_active_num
|
|
buffer(1) += mo_grad_p(det(i,k,2),1)*mo_value_p(det(i,l,2)) &
|
|
+ mo_grad_p(det(i,l,2),1)*mo_value_p(det(i,k,2))
|
|
buffer(2) += mo_grad_p(det(i,k,2),2)*mo_value_p(det(i,l,2)) &
|
|
+ mo_grad_p(det(i,l,2),2)*mo_value_p(det(i,k,2))
|
|
buffer(3) += mo_grad_p(det(i,k,2),3)*mo_value_p(det(i,l,2)) &
|
|
+ mo_grad_p(det(i,l,2),3)*mo_value_p(det(i,k,2))
|
|
enddo
|
|
density_beta_grad_p(1) += det_coef(k)*det_coef(l)*buffer(1)
|
|
density_beta_grad_p(2) += det_coef(k)*det_coef(l)*buffer(2)
|
|
density_beta_grad_p(3) += det_coef(k)*det_coef(l)*buffer(3)
|
|
enddo
|
|
enddo
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, density_alpha_lapl_p ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Laplacian of the density at the current point
|
|
END_DOC
|
|
|
|
integer :: i
|
|
|
|
density_alpha_lapl_p = 0.
|
|
|
|
do i=1,mo_closed_num
|
|
density_alpha_lapl_p += mo_grad_p(i,1)**2
|
|
density_alpha_lapl_p += mo_grad_p(i,2)**2
|
|
density_alpha_lapl_p += mo_grad_p(i,3)**2
|
|
density_alpha_lapl_p += mo_value_p(i)*mo_lapl_p(i)
|
|
enddo
|
|
density_alpha_lapl_p *= 2.
|
|
|
|
! TODO vectorization
|
|
integer :: k,j,l
|
|
real :: buffer
|
|
if (det_num > 1) then
|
|
call abrt(irp_here,'Need to implement Slater rules for gradient')
|
|
endif
|
|
do k=1,det_num
|
|
do l=1,det_num
|
|
buffer = 0.
|
|
do i=1,mo_active_num
|
|
buffer += 2.*(mo_grad_p(det(i,k,1),1)*mo_grad_p(det(i,l,1),1) &
|
|
+ mo_grad_p(det(i,k,1),2)*mo_grad_p(det(i,l,1),2) &
|
|
+ mo_grad_p(det(i,k,1),3)*mo_grad_p(det(i,l,1),3))&
|
|
+ mo_value_p(det(i,k,1))*mo_lapl_p(det(i,l,1)) &
|
|
+ mo_value_p(det(i,l,1))*mo_lapl_p(det(i,k,1))
|
|
enddo
|
|
density_alpha_lapl_p += det_coef(k)*det_coef(l)*buffer
|
|
enddo
|
|
enddo
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, density_beta_lapl_p ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Laplacian of the density at the current point
|
|
END_DOC
|
|
|
|
integer :: i
|
|
|
|
density_beta_lapl_p = 0.
|
|
|
|
do i=1,mo_closed_num
|
|
density_beta_lapl_p += mo_grad_p(i,1)**2
|
|
density_beta_lapl_p += mo_grad_p(i,2)**2
|
|
density_beta_lapl_p += mo_grad_p(i,3)**2
|
|
density_beta_lapl_p += mo_value_p(i)*mo_lapl_p(i)
|
|
enddo
|
|
density_beta_lapl_p *= 2.
|
|
|
|
! TODO vectorization
|
|
if (det_num > 1) then
|
|
call abrt(irp_here,'Need to implement Slater rules for laplacian')
|
|
endif
|
|
integer :: k,j,l
|
|
real :: buffer
|
|
do k=1,det_num
|
|
do l=1,det_num
|
|
buffer = 0.
|
|
do i=1,mo_active_num
|
|
buffer += 2.*(mo_grad_p(det(i,k,2),1)*mo_grad_p(det(i,l,2),1) &
|
|
+ mo_grad_p(det(i,k,2),2)*mo_grad_p(det(i,l,2),2) &
|
|
+ mo_grad_p(det(i,k,2),3)*mo_grad_p(det(i,l,2),3))&
|
|
+ mo_value_p(det(i,k,2))*mo_lapl_p(det(i,l,2)) &
|
|
+ mo_value_p(det(i,l,2))*mo_lapl_p(det(i,k,2))
|
|
enddo
|
|
density_beta_lapl_p += det_coef(k)*det_coef(l)*buffer
|
|
enddo
|
|
enddo
|
|
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, density_lapl_p ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Laplacian of the density at the current point
|
|
END_DOC
|
|
|
|
density_lapl_p = density_alpha_lapl_p + density_beta_lapl_p
|
|
|
|
END_PROVIDER
|
|
|