9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-04-25 17:54:44 +02:00

Fixed representations in spherical AOs

This commit is contained in:
Anthony Scemama 2025-03-20 12:14:31 +01:00
parent 8ca5bc68da
commit 9c1f811800
6 changed files with 31 additions and 17 deletions

View File

@ -99,8 +99,9 @@ BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_inv, (ao_sphe_num,ao_num) ]
R(:,:) = ao_cart_to_sphe_coef(:,:)
call dgemm('N','T', m, m, k, 1.d0, R, k, R, k, 0.d0, S, m)
call get_pseudo_inverse(S, k, k, m, Sinv, k, 1.d-20)
call dgemm('T','T', m, m, k, 1.d0, R, k, Sinv, k, 0.d0, Rinv, m)
call get_pseudo_inverse(S, k, k, m, Sinv, k, 1.d-12)
call dgemm('T','N', m, m, k, 1.d0, R, k, Sinv, k, 0.d0, Rinv, m)
integer :: i
do i=1,ao_num

View File

@ -317,12 +317,12 @@ BEGIN_PROVIDER [ double precision, ao_sphe_overlap, (ao_sphe_num,ao_sphe_num) ]
double precision, allocatable :: tmp(:,:)
allocate (tmp(ao_sphe_num,ao_num))
call dgemm('T','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
call dgemm('N','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
ao_cart_to_sphe_inv,size(ao_cart_to_sphe_inv,1), &
ao_overlap,size(ao_overlap,1), 0.d0, &
tmp, size(tmp,1))
call dgemm('N','N',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
call dgemm('N','T',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
tmp, size(tmp,1), &
ao_cart_to_sphe_inv,size(ao_cart_to_sphe_inv,1), 0.d0, &
ao_sphe_overlap,size(ao_sphe_overlap,1))

View File

@ -199,12 +199,12 @@ BEGIN_PROVIDER [ double precision, ao_sphe_kinetic_integrals, (ao_sphe_num,ao_sp
double precision, allocatable :: tmp(:,:)
allocate (tmp(ao_sphe_num,ao_num))
call dgemm('T','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
call dgemm('N','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
ao_cart_to_sphe_inv,size(ao_cart_to_sphe_inv,1), &
ao_kinetic_integrals,size(ao_kinetic_integrals,1), 0.d0, &
tmp, size(tmp,1))
call dgemm('N','N',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
call dgemm('N','T',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
tmp, size(tmp,1), &
ao_cart_to_sphe_inv,size(ao_cart_to_sphe_inv,1), 0.d0, &
ao_sphe_kinetic_integrals,size(ao_sphe_kinetic_integrals,1))

View File

@ -618,12 +618,12 @@ BEGIN_PROVIDER [ double precision, ao_sphe_integrals_n_e, (ao_sphe_num,ao_sphe_n
double precision, allocatable :: tmp(:,:)
allocate (tmp(ao_sphe_num,ao_num))
call dgemm('T','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
call dgemm('N','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
ao_cart_to_sphe_inv,size(ao_cart_to_sphe_inv,1), &
ao_integrals_n_e,size(ao_integrals_n_e,1), 0.d0, &
tmp, size(tmp,1))
call dgemm('N','N',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
call dgemm('N','T',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
tmp, size(tmp,1), &
ao_cart_to_sphe_inv,size(ao_cart_to_sphe_inv,1), 0.d0, &
ao_sphe_integrals_n_e,size(ao_sphe_integrals_n_e,1))

View File

@ -352,14 +352,31 @@ BEGIN_PROVIDER [ double precision, mo_sphe_coef, (ao_sphe_num, mo_num) ]
BEGIN_DOC
! MO coefficients in the basis of spherical harmonics AOs.
END_DOC
double precision, allocatable :: tmp(:,:)
allocate (tmp(ao_sphe_num,ao_num))
double precision, allocatable, dimension (:,:) :: C0, S, tmp
allocate(C0(ao_sphe_num,mo_num), S(mo_num,mo_num), tmp(mo_num,ao_sphe_num))
call dgemm('T','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
call dgemm('T','N',ao_sphe_num,mo_num,ao_num, 1.d0, &
ao_cart_to_sphe_coef,ao_num, &
mo_coef,size(mo_coef,1), 0.d0, &
mo_sphe_coef, size(mo_sphe_coef,1))
C0, size(C0,1))
deallocate (tmp)
! C0^T S S^0
call dgemm('T','N',mo_num,ao_sphe_num,ao_sphe_num, 1.d0, &
C0,size(C0,1), &
ao_sphe_overlap,size(ao_sphe_overlap,1), 0.d0, &
tmp, size(tmp,1))
call dgemm('N','N',mo_num,mo_num,ao_sphe_num, 1.d0, &
tmp, size(tmp,1), &
C0,size(C0,1), 0.d0, &
S, size(S,1))
integer :: m
m = ao_sphe_num
mo_sphe_coef = C0
call ortho_lowdin(S,size(S,1),mo_num,mo_sphe_coef,ao_sphe_num,m,1.d-10)
deallocate (tmp, S, C0)
END_PROVIDER

View File

@ -239,10 +239,6 @@ END_DOC
endif
i = j
enddo
TOUCH mo_coef
call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1), &
size(Fock_matrix_mo,2),mo_label,1,.true.)
call restore_symmetry(ao_num, mo_num, mo_coef, size(mo_coef,1), 1.d-10)
if(do_mom)then
call reorder_mo_max_overlap