mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-30 15:53:42 +02:00
natural orbitals of the super_ci works
This commit is contained in:
parent
ecc9faa0b9
commit
713ef176a1
@ -39,6 +39,7 @@ subroutine routine_bis
|
|||||||
accu_d += psi_coef(i,1)**2
|
accu_d += psi_coef(i,1)**2
|
||||||
enddo
|
enddo
|
||||||
print*,'accu_d = ',accu_d
|
print*,'accu_d = ',accu_d
|
||||||
|
provide superci_natorb
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine routine
|
subroutine routine
|
||||||
|
@ -52,8 +52,8 @@
|
|||||||
! equation B3.c of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
! equation B3.c of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
do i = 1, n_core_inact_orb
|
do i = 1, n_core_inact_orb
|
||||||
iorb = list_core_inact(i)
|
iorb = list_core_inact(i)
|
||||||
do a = 1, n_act_orb
|
do a = 1, n_virt_orb
|
||||||
aorb = list_act(a)
|
aorb = list_virt(a)
|
||||||
super_ci_dm(aorb,iorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
super_ci_dm(aorb,iorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
||||||
super_ci_dm(iorb,aorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
super_ci_dm(iorb,aorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
||||||
enddo
|
enddo
|
||||||
@ -125,6 +125,12 @@
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, superci_natorb, (ao_num,mo_num)
|
||||||
|
&BEGIN_PROVIDER [double precision, superci_nat_occ, (mo_num)
|
||||||
|
implicit none
|
||||||
|
call general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(super_ci_dm,mo_num,mo_num,mo_num,superci_nat_occ,superci_natorb)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, mat_tmp_dm_super_ci, (n_act_orb,n_act_orb)]
|
BEGIN_PROVIDER [double precision, mat_tmp_dm_super_ci, (n_act_orb,n_act_orb)]
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -217,3 +217,59 @@ subroutine mo_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,label)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,mo_coef_new)
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: lda,m,n
|
||||||
|
double precision, intent(in) :: matrix(lda,n)
|
||||||
|
double precision, intent(out) :: eig(m),mo_coef_new(ao_num,m)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: mo_coef_tmp(:,:), U(:,:),D(:), A(:,:), Vt(:,:), work(:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),D(m),Vt(lda,n),mo_coef_tmp(ao_num,mo_num))
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_tmp = mo_coef
|
||||||
|
|
||||||
|
call svd(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + D(i)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef_new,size(mo_coef,1))
|
||||||
|
|
||||||
|
do i=1,m
|
||||||
|
eig(i) = D(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(A,U,Vt,D,mo_coef_tmp)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user