mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-24 21:41:46 +02:00
Fixed linear-dep threshold
This commit is contained in:
parent
a68f3bb909
commit
9d1ab2848d
@ -129,7 +129,7 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
ao_ortho_canonical_num = ao_cart_to_sphe_num
|
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)
|
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, &
|
call dgemm('N','N', ao_num, ao_ortho_canonical_num, ao_cart_to_sphe_num, 1.d0, &
|
||||||
|
@ -81,10 +81,11 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
|
|||||||
|
|
||||||
call svd(overlap,lda,U,ldc,D,Vt,lda,n,n)
|
call svd(overlap,lda,U,ldc,D,Vt,lda,n,n)
|
||||||
|
|
||||||
|
D(:) = dsqrt(D(:))
|
||||||
m=n
|
m=n
|
||||||
do i=1,n
|
do i=1,n
|
||||||
if ( D(i) >= 1.d-6 ) then
|
if ( D(i) >= 1.d-6 ) then
|
||||||
D(i) = 1.d0/dsqrt(D(i))
|
D(i) = 1.d0/D(i)
|
||||||
else
|
else
|
||||||
m = i-1
|
m = i-1
|
||||||
print *, 'Removed Linear dependencies below:', 1.d0/D(m)
|
print *, 'Removed Linear dependencies below:', 1.d0/D(m)
|
||||||
@ -101,25 +102,19 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
|
|||||||
endif
|
endif
|
||||||
enddo
|
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 j=1,n
|
||||||
do i=1,n
|
do i=1,n
|
||||||
S(i,j) = U(i,j)*D(j)
|
S(i,j) = U(i,j)*D(j)
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
do i=1,n
|
do i=1,n
|
||||||
U(i,j) = C(i,j)
|
U(i,j) = C(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END DO
|
|
||||||
|
|
||||||
!$OMP END PARALLEL
|
call dgemm('N','N',n,n,n,1.d0,U,size(U,1),S,size(S,1),0.d0,C,size(C,1))
|
||||||
|
|
||||||
call dgemm('N','N',n,m,n,1.d0,U,size(U,1),S,size(S,1),0.d0,C,size(C,1))
|
|
||||||
deallocate (U, Vt, D, S)
|
deallocate (U, Vt, D, S)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
Loading…
Reference in New Issue
Block a user