LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-03 01:56:05 +01:00
Code Issues Releases Wiki Activity

Fixed linear-dep threshold

Browse Source
This commit is contained in:
Anthony Scemama 2018-01-08 18:26:51 +01:00
parent a68f3bb909
commit 9d1ab2848d
2 changed files with 7 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/MO_Basis/ao_ortho_canonical.irp.f
View File

@ -129,7 +129,7 @@ END_PROVIDER
enddo
ao_ortho_canonical_num = ao_cart_to_sphe_num
call ortho_canonical (ao_cart_to_sphe_overlap, size(ao_cart_to_sphe_overlap,1), &
call ortho_canonical(ao_cart_to_sphe_overlap, size(ao_cart_to_sphe_overlap,1), &
ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num)
call dgemm('N','N', ao_num, ao_ortho_canonical_num, ao_cart_to_sphe_num, 1.d0, &

17
src/Utils/LinearAlgebra.irp.f
View File

@ -81,10 +81,11 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
call svd(overlap,lda,U,ldc,D,Vt,lda,n,n)
D(:) = dsqrt(D(:))
m=n
do i=1,n
if ( D(i) >= 1.d-6 ) then
D(i) = 1.d0/dsqrt(D(i))
D(i) = 1.d0/D(i)
else
m = i-1
print *, 'Removed Linear dependencies below:', 1.d0/D(m)
@ -101,25 +102,19 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
endif
enddo
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(S,U,D,Vt,n,C,m) &
!$OMP PRIVATE(i,j)
!$OMP DO
do j=1,n
do i=1,n
S(i,j) = U(i,j)*D(j)
enddo
enddo
do j=1,n
do i=1,n
U(i,j) = C(i,j)
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
call dgemm('N','N',n,m,n,1.d0,U,size(U,1),S,size(S,1),0.d0,C,size(C,1))
call dgemm('N','N',n,n,n,1.d0,U,size(U,1),S,size(S,1),0.d0,C,size(C,1))
deallocate (U, Vt, D, S)
end