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