10
1
mirror of https://github.com/pfloos/quack synced 2024-12-26 14:23:38 +01:00
QuAcK/src/eDFT/unrestricted_density_matrix.f90

49 lines
1.0 KiB
Fortran
Raw Normal View History

2020-09-11 11:55:04 +02:00
subroutine unrestricted_density_matrix(nBas,nEns,c,P,occnum)
2020-03-15 14:34:18 +01:00
! Calculate density matrices
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
integer,intent(in) :: nEns
double precision,intent(in) :: c(nBas,nBas,nspin)
2020-09-11 11:55:04 +02:00
double precision,intent(in) :: occnum(nBas,nspin,nEns)
2020-03-15 14:34:18 +01:00
! Local variables
integer :: ispin
integer :: iEns
2020-09-11 11:55:04 +02:00
integer :: q
integer :: mu,nu
2020-03-15 14:34:18 +01:00
! Output variables
double precision,intent(out) :: P(nBas,nBas,nspin,nEns)
2020-09-11 11:55:04 +02:00
! Compute density matrix for each state of the ensemble based on occupation numbers
P(:,:,:,:) = 0d0
do iEns=1,nEns
do ispin=1,nspin
do mu=1,nBas
do nu=1,nBas
do q=1,nBas
P(mu,nu,ispin,iEns) = P(mu,nu,ispin,iEns) &
+ occnum(q,ispin,iEns)*c(mu,q,ispin)*c(nu,q,ispin)
end do
end do
end do
end do
2020-03-15 14:34:18 +01:00
end do
2020-09-11 11:55:04 +02:00
2020-03-15 14:34:18 +01:00
end subroutine unrestricted_density_matrix