mirror of
https://github.com/pfloos/quack
synced 2024-12-23 04:43:53 +01:00
sort ppRPA
This commit is contained in:
parent
1b3be7ae89
commit
f700c431d6
33
input/basis
33
input/basis
@ -1,30 +1,9 @@
|
||||
1 6
|
||||
1 3
|
||||
S 3
|
||||
1 33.8700000 0.0060680
|
||||
2 5.0950000 0.0453080
|
||||
3 1.1590000 0.2028220
|
||||
1 38.3600000 0.0238090
|
||||
2 5.7700000 0.1548910
|
||||
3 1.2400000 0.4699870
|
||||
S 1
|
||||
1 0.3258000 1.0000000
|
||||
S 1
|
||||
1 0.1027000 1.0000000
|
||||
1 0.2976000 1.0000000
|
||||
P 1
|
||||
1 1.4070000 1.0000000
|
||||
P 1
|
||||
1 0.3880000 1.0000000
|
||||
D 1
|
||||
1 1.0570000 1.0000000
|
||||
2 6
|
||||
S 3
|
||||
1 33.8700000 0.0060680
|
||||
2 5.0950000 0.0453080
|
||||
3 1.1590000 0.2028220
|
||||
S 1
|
||||
1 0.3258000 1.0000000
|
||||
S 1
|
||||
1 0.1027000 1.0000000
|
||||
P 1
|
||||
1 1.4070000 1.0000000
|
||||
P 1
|
||||
1 0.3880000 1.0000000
|
||||
D 1
|
||||
1 1.0570000 1.0000000
|
||||
1 1.2750000 1.0000000
|
||||
|
@ -1,5 +1,4 @@
|
||||
# nAt nEla nElb nCore nRyd
|
||||
2 1 1 0 0
|
||||
1 1 1 0 0
|
||||
# Znuc x y z
|
||||
H 0. 0. 0.
|
||||
H 0. 0. 1.4
|
||||
He 0.0 0.0 0.0
|
||||
|
@ -1,4 +1,3 @@
|
||||
2
|
||||
1
|
||||
|
||||
H 0.0000000000 0.0000000000 0.0000000000
|
||||
H 0.0000000000 0.0000000000 0.7408481486
|
||||
He 0.0000000000 0.0000000000 0.0000000000
|
||||
|
33
input/weight
33
input/weight
@ -1,30 +1,9 @@
|
||||
1 6
|
||||
1 3
|
||||
S 3
|
||||
1 33.8700000 0.0060680
|
||||
2 5.0950000 0.0453080
|
||||
3 1.1590000 0.2028220
|
||||
1 38.3600000 0.0238090
|
||||
2 5.7700000 0.1548910
|
||||
3 1.2400000 0.4699870
|
||||
S 1
|
||||
1 0.3258000 1.0000000
|
||||
S 1
|
||||
1 0.1027000 1.0000000
|
||||
1 0.2976000 1.0000000
|
||||
P 1
|
||||
1 1.4070000 1.0000000
|
||||
P 1
|
||||
1 0.3880000 1.0000000
|
||||
D 1
|
||||
1 1.0570000 1.0000000
|
||||
2 6
|
||||
S 3
|
||||
1 33.8700000 0.0060680
|
||||
2 5.0950000 0.0453080
|
||||
3 1.1590000 0.2028220
|
||||
S 1
|
||||
1 0.3258000 1.0000000
|
||||
S 1
|
||||
1 0.1027000 1.0000000
|
||||
P 1
|
||||
1 1.4070000 1.0000000
|
||||
P 1
|
||||
1 0.3880000 1.0000000
|
||||
D 1
|
||||
1 1.0570000 1.0000000
|
||||
1 1.2750000 1.0000000
|
||||
|
@ -138,7 +138,7 @@ subroutine linear_response_pp(ispin,ortho_eigvec,BSE,nBas,nC,nO,nV,nR,nOO,nVV, &
|
||||
EcRPA = 0.5d0*( sum(Omega1(:)) - sum(Omega2(:)) - trace_matrix(nVV,C(:,:)) - trace_matrix(nOO,D(:,:)) )
|
||||
EcRPA1 = +sum(Omega1(:)) - trace_matrix(nVV,C(:,:))
|
||||
EcRPA2 = -sum(Omega2(:)) - trace_matrix(nOO,D(:,:))
|
||||
if(abs(EcRPA - EcRPA1) > 1d-10 .or. abs(EcRPA - EcRPA2) > 1d-10) &
|
||||
if(abs(EcRPA - EcRPA1) > 1d-6 .or. abs(EcRPA - EcRPA2) > 1d-6) &
|
||||
print*,'!!! Issue in pp-RPA linear reponse calculation RPA1 != RPA2 !!!'
|
||||
|
||||
! write(*,*)'X1'
|
||||
|
@ -34,9 +34,9 @@ subroutine orthogonalization_matrix(ortho_type,nBas,S,X)
|
||||
|
||||
if(ortho_type == 1) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*) ' Lowdin orthogonalization'
|
||||
write(*,*)
|
||||
! write(*,*)
|
||||
! write(*,*) ' Lowdin orthogonalization'
|
||||
! write(*,*)
|
||||
|
||||
Uvec = S
|
||||
call diagonalize_matrix(nBas,Uvec,Uval)
|
||||
|
@ -16,6 +16,8 @@ subroutine sort_ppRPA(ortho_eigvec,nOO,nVV,Omega,Z,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
! Local variables
|
||||
|
||||
integer :: pq,ab,ij
|
||||
integer :: deg1,ab_start,ab_end
|
||||
integer :: deg2,ij_start,ij_end
|
||||
double precision,allocatable :: M(:,:)
|
||||
double precision,allocatable :: Z1(:,:)
|
||||
double precision,allocatable :: Z2(:,:)
|
||||
@ -24,6 +26,9 @@ subroutine sort_ppRPA(ortho_eigvec,nOO,nVV,Omega,Z,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
double precision,allocatable :: O1(:,:)
|
||||
double precision,allocatable :: O2(:,:)
|
||||
|
||||
integer,allocatable :: order1(:)
|
||||
integer,allocatable :: order2(:)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: Omega1(nVV)
|
||||
@ -37,8 +42,7 @@ subroutine sort_ppRPA(ortho_eigvec,nOO,nVV,Omega,Z,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
allocate(M(nOO+nVV,nOO+nVV), &
|
||||
Z1(nOO+nVV,nVV),Z2(nOO+nVV,nOO), &
|
||||
S1(nVV,nVV),S2(nOO,nOO), &
|
||||
O1(nVV,nVV),O2(nOO,nOO))
|
||||
order1(nVV),order2(nOO))
|
||||
|
||||
! Initializatiom
|
||||
|
||||
@ -88,6 +92,20 @@ subroutine sort_ppRPA(ortho_eigvec,nOO,nVV,Omega,Z,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
if(minval(Omega1(:)) < 0d0 .or. ab /= nVV) call print_warning('You may have instabilities in pp-RPA!!')
|
||||
if(maxval(Omega2(:)) > 0d0 .or. ij /= nOO) call print_warning('You may have instabilities in pp-RPA!!')
|
||||
|
||||
do ab=1,nVV
|
||||
order1(ab) = ab
|
||||
end do
|
||||
|
||||
do ij=1,nOO
|
||||
order2(ij) = ij
|
||||
end do
|
||||
|
||||
call quick_sort(Omega1(:),order1(:),nVV)
|
||||
call set_order(Z1(:,:),order1(:),nOO+nVV,nVV)
|
||||
|
||||
call quick_sort(Omega2(:),order2(:),nOO)
|
||||
call set_order(Z2(:,:),order2(:),nOO+nVV,nOO)
|
||||
|
||||
! write(*,*) 'pp-RPA positive excitation energies'
|
||||
! call matout(nVV,1,Omega1(:))
|
||||
! write(*,*)
|
||||
@ -100,14 +118,75 @@ subroutine sort_ppRPA(ortho_eigvec,nOO,nVV,Omega,Z,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
if(ortho_eigvec) then
|
||||
|
||||
S1 = + matmul(transpose(Z1),matmul(M,Z1))
|
||||
S2 = - matmul(transpose(Z2),matmul(M,Z2))
|
||||
! Find degenerate eigenvalues
|
||||
|
||||
if(nVV > 0) call orthogonalization_matrix(1,nVV,S1,O1)
|
||||
if(nOO > 0) call orthogonalization_matrix(1,nOO,S2,O2)
|
||||
deg1 = 1
|
||||
ab_start = 1
|
||||
|
||||
Z1 = matmul(Z1,O1)
|
||||
Z2 = matmul(Z2,O2)
|
||||
do ab=1,nVV
|
||||
|
||||
if(ab < nVV .and. abs(Omega1(ab) - Omega1(ab+1)) < 1d-10) then
|
||||
|
||||
if(deg1 == 1) ab_start = ab
|
||||
deg1 = deg1 + 1
|
||||
|
||||
else
|
||||
|
||||
ab_end = ab
|
||||
! print*,'deg = ',deg1,ab_start,ab_end
|
||||
|
||||
allocate(S1(deg1,deg1),O1(deg1,deg1))
|
||||
|
||||
S1 = matmul(transpose(Z1(:,ab_start:ab_end)),matmul(M,Z1(:,ab_start:ab_end)))
|
||||
call orthogonalization_matrix(1,deg1,S1,O1)
|
||||
Z1(:,ab_start:ab_end) = matmul(Z1(:,ab_start:ab_end),O1)
|
||||
|
||||
deallocate(S1,O1)
|
||||
|
||||
deg1 = 1
|
||||
ab_start = ab + 1
|
||||
|
||||
end if
|
||||
end do
|
||||
|
||||
deg2 = 1
|
||||
ij_start = 1
|
||||
|
||||
do ij=1,nOO
|
||||
|
||||
if(ij < nOO .and. abs(Omega2(ij) - Omega2(ij+1)) < 1d-10) then
|
||||
|
||||
if(deg2 == 1) ij_start = ij
|
||||
deg2 = deg2 + 1
|
||||
|
||||
else
|
||||
|
||||
ij_end = ij
|
||||
! print*,'deg = ',deg2,ij_start,ij_end
|
||||
|
||||
allocate(S2(deg2,deg2),O2(deg2,deg2))
|
||||
|
||||
S2 = - matmul(transpose(Z2(:,ij_start:ij_end)),matmul(M,Z2(:,ij_start:ij_end)))
|
||||
call orthogonalization_matrix(1,deg2,S2,O2)
|
||||
Z2(:,ij_start:ij_end) = matmul(Z2(:,ij_start:ij_end),O2)
|
||||
|
||||
deallocate(S2,O2)
|
||||
|
||||
deg2 = 1
|
||||
ij_start = ij + 1
|
||||
|
||||
end if
|
||||
end do
|
||||
|
||||
! allocate(S1(nVV,nVV),S2(nOO,nOO),O1(nVV,nVV),O2(nOO,nOO))
|
||||
! S1 = + matmul(transpose(Z1),matmul(M,Z1))
|
||||
! S2 = - matmul(transpose(Z2),matmul(M,Z2))
|
||||
|
||||
! if(nVV > 0) call orthogonalization_matrix(1,nVV,S1,O1)
|
||||
! if(nOO > 0) call orthogonalization_matrix(1,nOO,S2,O2)
|
||||
|
||||
! Z1 = matmul(Z1,O1)
|
||||
! Z2 = matmul(Z2,O2)
|
||||
|
||||
end if
|
||||
|
||||
|
@ -1,35 +1,3 @@
|
||||
!subroutine diagonalize_matrix_lowest(N,M,A,e)
|
||||
!
|
||||
!! Diagonalize a square matrix but only provide the M lowest eigenvalues/eigenvectors
|
||||
!
|
||||
! implicit none
|
||||
!
|
||||
!! Input variables
|
||||
!
|
||||
! integer,intent(in) :: N
|
||||
! integer,intent(in) :: M
|
||||
! double precision,intent(inout):: A(N,N)
|
||||
! double precision,intent(out) :: e(N)
|
||||
!
|
||||
!! Local variables
|
||||
!
|
||||
! integer :: lwork,info
|
||||
! double precision,allocatable :: work(:)
|
||||
!
|
||||
!! Memory allocation
|
||||
!
|
||||
! allocate(work(3*N))
|
||||
! lwork = size(work)
|
||||
! abstol = 1d-15
|
||||
!
|
||||
! call dsyevx('V','I','U',N,A,N,VL,VU,1,M,abstol,M,e,work,lwork,info)
|
||||
!
|
||||
! if(info /= 0) then
|
||||
! print*,'Problem in diagonalize_matrix (dsyev)!!'
|
||||
! endif
|
||||
!
|
||||
!end subroutine diagonalize_matrix_lowest
|
||||
|
||||
subroutine diagonalize_general_matrix(N,A,WR,VR)
|
||||
|
||||
! Diagonalize a non-symmetric square matrix
|
||||
@ -53,35 +21,13 @@ subroutine diagonalize_general_matrix(N,A,WR,VR)
|
||||
|
||||
lwork = 4*N
|
||||
allocate(WI(N),VL(N,N),work(lwork))
|
||||
! tmp1 = A
|
||||
|
||||
call dgeev('V','V',N,A,N,WR,WI,VL,N,VR,N,work,lwork,info)
|
||||
|
||||
if(info /= 0) then
|
||||
print*,'Problem in diagonalize_general_matrix (dgeev)!!'
|
||||
endif
|
||||
|
||||
! tmp2 = 0d0
|
||||
! do i=1,N
|
||||
! do j=1,N
|
||||
! do k=1,N
|
||||
! tmp2(i,j) = tmp2(i,j) + tmp1(i,k)*vr(k,j)
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! print*,'tmp2'
|
||||
! call matout(N,N,tmp2)
|
||||
|
||||
! tmp1 = 0d0
|
||||
! do i=1,N
|
||||
! do j=1,N
|
||||
! tmp1(i,j) = wr(j)*vr(i,j)
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! print*,'tmp1'
|
||||
! call matout(N,N,tmp1)
|
||||
|
||||
end subroutine diagonalize_general_matrix
|
||||
|
||||
subroutine diagonalize_matrix(N,A,e)
|
||||
|
Loading…
Reference in New Issue
Block a user