mirror of
https://github.com/pfloos/quack
synced 2024-11-09 07:33:55 +01:00
58 lines
1.2 KiB
Fortran
58 lines
1.2 KiB
Fortran
|
subroutine natural_orbital(nBas,nO,cHF,c)
|
||
|
|
|
||
|
|
! Compute natural orbitals and natural occupancies
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
include 'parameters.h'
|
||
|
|
|
||
|
|
! Input variables
|
||
|
|
|
||
|
|
integer,intent(in) :: nBas,nO
|
||
|
|
double precision,intent(in) :: cHF(nBas,nBas),c(nBas,nBas)
|
||
|
|
|
||
|
|
! Local variables
|
||
|
|
|
||
|
|
integer :: i,j,k
|
||
|
|
double precision,allocatable :: eNO(:),cNO(:,:),P(:,:)
|
||
|
|
|
||
|
|
! Allocate
|
||
|
|
|
||
|
|
allocate(eNO(nBas),cNO(nBas,nBas),P(nBas,nBas))
|
||
|
|
|
||
|
|
! Compute density matrix
|
||
|
|
|
||
|
|
P = matmul(transpose(cHF),cHF)
|
||
|
|
|
||
|
|
call matout(nBas,nBas,P)
|
||
|
|
|
||
|
|
cNO = 0d0
|
||
|
|
|
||
|
|
do i=1,nBas
|
||
|
|
do j=1,nBas
|
||
|
|
do k=1,1
|
||
|
|
cNO(i,j) = cNO(i,j) + 2d0*P(i,k)*P(j,k)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
! cNO(:,:) = matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||
|
|
|
||
|
|
! cNO = matmul(transpose(cHF),matmul(cNO,cHF))
|
||
|
|
|
||
|
|
call diagonalize_matrix(nBas,cNO,eNO)
|
||
|
|
|
||
|
|
! Print results
|
||
|
|
|
||
|
|
write(*,'(A50)') '---------------------------------------'
|
||
|
|
write(*,'(A32)') ' Natural orbitals '
|
||
|
|
write(*,'(A50)') '---------------------------------------'
|
||
|
|
call matout(nBas,nBas,cNO)
|
||
|
|
write(*,*)
|
||
|
|
write(*,'(A50)') '---------------------------------------'
|
||
|
|
write(*,'(A32)') ' Natural occupancies'
|
||
|
|
write(*,'(A50)') '---------------------------------------'
|
||
|
|
call matout(nBas,1,eNO)
|
||
|
|
write(*,*)
|
||
|
|
|
||
|
|
end subroutine natural_orbital
|