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)**2
 enddo

! TODO vectorization
 integer :: k,j,l, ik, il
 real    :: buffer
 real    :: phase
 integer :: exc(4)
 PROVIDE det
 PROVIDE elec_alpha_num
 do k=1,det_num
  do l=1,det_num

   exc(1) = abs(det_exc(k,l,1))
   exc(2) = abs(det_exc(k,l,2))
   exc(3) = exc(1)+exc(2)
   exc(4) = exc(1)*exc(2)
   if (exc(4) /= 0) then
    exc(4) = exc(4)/abs(exc(4))
   else
    exc(4) = 1
   endif

   phase = dble(exc(4))
   if (exc(3) == 0) then
     buffer = 0.
     do i=1,elec_alpha_num-mo_closed_num
      buffer += mo_value_p(det(i,k,1))*mo_value_p(det(i,l,1))
     enddo
     density_alpha_value_p += phase*det_coef(k)*det_coef(l)*buffer
   else if ( (exc(3) == 1).and.(exc(1) == 1) ) then
     call get_single_excitation(k,l,ik,il,1)
     buffer = mo_value_p(ik)*mo_value_p(il)
     density_alpha_value_p += phase*det_coef(k)*det_coef(l)*buffer
   endif

  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.
 integer :: i
 do i=1,mo_closed_num
  density_beta_value_p += mo_value_p(i)**2
 enddo

! TODO vectorization
 integer :: k,j,l, ik, il
 real    :: buffer
 real    :: phase
 integer :: exc(4)
 PROVIDE det
 PROVIDE elec_beta_num

 do k=1,det_num
  do l=1,det_num
   exc(1) = abs(det_exc(k,l,1))
   exc(2) = abs(det_exc(k,l,2))
   exc(3) = exc(1)+exc(2)
   exc(4) = exc(1)*exc(2)
   if (exc(4) /= 0) then
    exc(4) = exc(4)/abs(exc(4))
   else
    exc(4) = 1
   endif

   phase = dble(exc(4))
   if (exc(3) == 0) then
     buffer = 0.
     do i=1,elec_beta_num-mo_closed_num
      buffer += mo_value_p(det(i,k,2))*mo_value_p(det(i,l,2))
     enddo
     density_beta_value_p += phase*det_coef(k)*det_coef(l)*buffer
   else if ( (exc(3) == 1).and.(exc(2) == 1) ) then
     call get_single_excitation(k,l,ik,il,2)
     buffer = mo_value_p(ik)*mo_value_p(il)
     density_beta_value_p += phase*det_coef(k)*det_coef(l)*buffer
   endif
  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