PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-04-05 00:11:42 +02:00
Code Releases Activity

Fix ao_sphe_overlap

Browse Source
This commit is contained in:
Anthony Scemama 2025-03-13 14:36:24 +01:00
parent 69d5811d14
commit d84edaad5f
3 changed files with 35 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/openmp.rc
View File

@ -1 +1 @@
export OMP_NESTED=True #export OMP_NESTED=True

49
src/ao_one_e_ints/ao_ortho_canonical.irp.f
View File

@ -1,5 +1,5 @@
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_coef, (ao_num,ao_num)] BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_coef, (ao_num,ao_num)]
&BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num ] &BEGIN_PROVIDER [ integer, ao_sphe_num ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Coefficients to go from cartesian to spherical coordinates in the current ! Coefficients to go from cartesian to spherical coordinates in the current
@ -13,23 +13,23 @@
ao_cart_to_sphe_coef(:,:) = 0.d0 ao_cart_to_sphe_coef(:,:) = 0.d0
! Assume order provided by ao_power_index ! Assume order provided by ao_power_index
i = 1 i = 1
ao_cart_to_sphe_num = 0 ao_sphe_num = 0
do while (i <= ao_num) do while (i <= ao_num)
select case ( ao_l(i) ) select case ( ao_l(i) )
case (0) case (0)
ao_cart_to_sphe_num += 1 ao_sphe_num += 1
ao_cart_to_sphe_coef(i,ao_cart_to_sphe_num) = 1.d0 ao_cart_to_sphe_coef(i,ao_sphe_num) = 1.d0
i += 1 i += 1
BEGIN_TEMPLATE BEGIN_TEMPLATE
case ($SHELL) case ($SHELL)
if (ao_power(i,1) == $SHELL) then if (ao_power(i,1) == $SHELL) then
do k=1,size(cart_to_sphe_$SHELL,2) do k=1,size(cart_to_sphe_$SHELL,2)
do j=1,size(cart_to_sphe_$SHELL,1) do j=1,size(cart_to_sphe_$SHELL,1)
ao_cart_to_sphe_coef(i+j-1,ao_cart_to_sphe_num+k) = cart_to_sphe_$SHELL(j,k) ao_cart_to_sphe_coef(i+j-1,ao_sphe_num+k) = cart_to_sphe_$SHELL(j,k)
enddo enddo
enddo enddo
i += size(cart_to_sphe_$SHELL,1) i += size(cart_to_sphe_$SHELL,1)
ao_cart_to_sphe_num += size(cart_to_sphe_$SHELL,2) ao_sphe_num += size(cart_to_sphe_$SHELL,2)
endif endif
SUBST [ SHELL ] SUBST [ SHELL ]
1;; 1;;
@ -49,36 +49,36 @@
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_overlap, (ao_cart_to_sphe_num,ao_cart_to_sphe_num) ] BEGIN_PROVIDER [ double precision, ao_sphe_overlap, (ao_sphe_num,ao_sphe_num) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! |AO| overlap matrix in the spherical basis set ! |AO| overlap matrix in the spherical basis set
END_DOC END_DOC
double precision, allocatable :: S(:,:) double precision, allocatable :: tmp(:,:)
allocate (S(ao_cart_to_sphe_num,ao_num)) allocate (tmp(ao_sphe_num,ao_num))
call dgemm('T','N',ao_cart_to_sphe_num,ao_num,ao_num, 1.d0, & call dgemm('T','N',ao_sphe_num,ao_num,ao_num, 1.d0, &
ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), & ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), &
ao_overlap,size(ao_overlap,1), 0.d0, & S_inv,size(ao_overlap,1), 0.d0, &
S, size(S,1)) tmp, size(tmp,1))
call dgemm('N','N',ao_cart_to_sphe_num,ao_cart_to_sphe_num,ao_num, 1.d0, & call dgemm('N','N',ao_sphe_num,ao_sphe_num,ao_num, 1.d0, &
S, size(S,1), & tmp, size(tmp,1), &
ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), 0.d0, & ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), 0.d0, &
ao_cart_to_sphe_overlap,size(ao_cart_to_sphe_overlap,1)) ao_sphe_overlap,size(ao_sphe_overlap,1))
deallocate(S) deallocate(tmp)
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_inv, (ao_cart_to_sphe_num,ao_num) ] BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_inv, (ao_sphe_num,ao_num) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Inverse of :c:data:`ao_cart_to_sphe_coef` ! Inverse of :c:data:`ao_cart_to_sphe_coef`
END_DOC END_DOC
call get_pseudo_inverse(ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1),& call get_pseudo_inverse(ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1),&
ao_num,ao_cart_to_sphe_num, & ao_num,ao_sphe_num, &
ao_cart_to_sphe_inv, size(ao_cart_to_sphe_inv,1), lin_dep_cutoff) ao_cart_to_sphe_inv, size(ao_cart_to_sphe_inv,1), lin_dep_cutoff)
END_PROVIDER END_PROVIDER
@ -120,17 +120,17 @@ END_PROVIDER
double precision, allocatable :: S(:,:) double precision, allocatable :: S(:,:)
allocate(S(ao_cart_to_sphe_num,ao_cart_to_sphe_num)) allocate(S(ao_sphe_num,ao_sphe_num))
S = 0.d0 S = 0.d0
do i=1,ao_cart_to_sphe_num do i=1,ao_sphe_num
S(i,i) = 1.d0 S(i,i) = 1.d0
enddo enddo
ao_ortho_canonical_num = ao_cart_to_sphe_num ao_ortho_canonical_num = ao_sphe_num
call ortho_canonical(ao_cart_to_sphe_overlap, size(ao_cart_to_sphe_overlap,1), & call ortho_canonical(ao_sphe_overlap, size(ao_sphe_overlap,1), &
ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num, lin_dep_cutoff) ao_sphe_num, S, size(S,1), ao_ortho_canonical_num, lin_dep_cutoff)
call dgemm('N','N', ao_num, ao_ortho_canonical_num, ao_cart_to_sphe_num, 1.d0, & call dgemm('N','N', ao_num, ao_ortho_canonical_num, ao_sphe_num, 1.d0, &
ao_cart_to_sphe_coef, size(ao_cart_to_sphe_coef,1), & ao_cart_to_sphe_coef, size(ao_cart_to_sphe_coef,1), &
S, size(S,1), & S, size(S,1), &
0.d0, ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1)) 0.d0, ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1))
@ -167,3 +167,4 @@ BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_ortho_canonica
enddo enddo
enddo enddo
END_PROVIDER END_PROVIDER

9
src/mo_basis/mos.irp.f
View File

@ -346,3 +346,12 @@ subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA)
deallocate(T) deallocate(T)
end end
BEGIN_PROVIDER [ double precision, mo_coef_spherical]
implicit none
BEGIN_DOC
! MO coefficients in the basis of spherical harmonics AOs.
END_DOC
END_PROVIDER