9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00

Moved lin_dep_cutoff

This commit is contained in:
Anthony Scemama 2020-06-04 18:27:44 +02:00
parent 8fdd44c6f0
commit ae01d339df
4 changed files with 50 additions and 51 deletions

View File

@ -13,9 +13,6 @@ dev:
bugfix: bugfix:
A fork of the *master* on which the bug fixes are made. A fork of the *master* on which the bug fixes are made.
dev:
Development branch
gh-pages: gh-pages:
This is an independent branch, containing only the web site of QP2. This is an independent branch, containing only the web site of QP2.

View File

@ -92,3 +92,9 @@ doc: Read/Write |AO| one-electron integrals from/to disk [ Write | Read | None ]
interface: ezfio,provider,ocaml interface: ezfio,provider,ocaml
default: None default: None
[lin_dep_cutoff]
type: Threshold
doc: Remove linear dependencies when the eigenvalues of the overlap matrix are below this value
interface: ezfio,provider,ocaml
default: 1.e-6

View File

@ -47,9 +47,3 @@ type: Disk_access
doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ] doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ]
interface: ezfio,provider,ocaml interface: ezfio,provider,ocaml
default: None default: None
[lin_dep_cutoff]
type: Threshold
doc: Remove linear dependencies when the eigenvalues of the overlap matrix are below this value
interface: ezfio,provider,ocaml
default: 1.e-6

View File

@ -120,6 +120,7 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m,cutoff)
complex*16, allocatable :: S(:,:) complex*16, allocatable :: S(:,:)
!DIR$ ATTRIBUTES ALIGN : 64 :: U, Vt, D !DIR$ ATTRIBUTES ALIGN : 64 :: U, Vt, D
integer :: info, i, j integer :: info, i, j
double precision :: local_cutoff
if (n < 2) then if (n < 2) then
return return
@ -130,13 +131,14 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m,cutoff)
call svd_complex(overlap,lda,U,ldc,D,Vt,lda,n,n) call svd_complex(overlap,lda,U,ldc,D,Vt,lda,n,n)
D(:) = dsqrt(D(:)) D(:) = dsqrt(D(:))
local_cutoff = dsqrt(cutoff)*D(1) ! such that D(i)/D(1) > dsqrt(cutoff) is kept
m=n m=n
do i=1,n do i=1,n
if ( D(i) >= cutoff ) then if ( D(i) >= local_cutoff ) then
D(i) = 1.d0/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:', local_cutoff
exit exit
endif endif
enddo enddo
@ -144,12 +146,6 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m,cutoff)
D(i) = 0.d0 D(i) = 0.d0
enddo enddo
do i=1,m
if ( D(i) >= 1.d5 ) then
print *, 'Warning: Basis set may have linear dependence problems'
endif
enddo
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)
@ -258,7 +254,8 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m,cutoff)
double precision, allocatable :: D(:) double precision, allocatable :: D(:)
complex*16, allocatable :: S(:,:) complex*16, allocatable :: S(:,:)
double precision, intent(in) :: cutoff double precision, intent(in) :: cutoff
integer :: info, i, j, k double precision :: local_cutoff
integer :: info, i, j, k, mm
if (n < 2) then if (n < 2) then
return return
@ -267,28 +264,32 @@ subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m,cutoff)
allocate(U(ldc,n),Vt(lda,n),S(lda,n),D(n)) allocate(U(ldc,n),Vt(lda,n),S(lda,n),D(n))
call svd_complex(overlap,lda,U,ldc,D,Vt,lda,n,n) call svd_complex(overlap,lda,U,ldc,D,Vt,lda,n,n)
D(:) = dsqrt(D(:))
!$OMP PARALLEL DEFAULT(NONE) & local_cutoff = dsqrt(cutoff)*D(1) ! such that D(i)/D(1) > dsqrt(cutoff) is kept
!$OMP SHARED(S,U,D,Vt,n,C,m,cutoff) & mm=n
!$OMP PRIVATE(i,j,k)
!$OMP DO
do i=1,n do i=1,n
if ( D(i) < cutoff) then if ( D(i) >= local_cutoff) then
print *, 'Removed Linear dependencies :', 1.d0/D(i) D(i) = 1.d0/D(i)
D(i) = 0.d0
else else
D(i) = 1.d0/dsqrt(D(i)) mm = mm-1
D(i) = 0.d0
endif endif
do j=1,n do j=1,n
S(j,i) = (0.d0,0.d0) S(j,i) = (0.d0,0.d0)
enddo enddo
enddo enddo
!$OMP END DO
if (mm < n) then
print *, 'Removed Linear dependencies below ', local_cutoff
endif
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(S,U,D,Vt,n,C,m,local_cutoff) &
!$OMP PRIVATE(i,j,k)
do k=1,n do k=1,n
if (D(k) /= 0.d0) then if (D(k) /= 0.d0) then
!$OMP DO !$OMP DO SCHEDULE(STATIC)
do j=1,n do j=1,n
do i=1,n do i=1,n
S(i,j) = S(i,j) + U(i,k)*D(k)*Vt(k,j) S(i,j) = S(i,j) + U(i,k)*D(k)*Vt(k,j)
@ -379,7 +380,7 @@ subroutine get_pseudo_inverse_complex(A,LDA,m,n,C,LDC,cutoff)
endif endif
do i=1,n do i=1,n
if (D(i)/D(1) > cutoff) then if (D(i) > cutoff*D(1)) then
D(i) = 1.d0/D(i) D(i) = 1.d0/D(i)
else else
D(i) = 0.d0 D(i) = 0.d0
@ -762,6 +763,7 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m,cutoff)
double precision, allocatable :: S(:,:) double precision, allocatable :: S(:,:)
!DIR$ ATTRIBUTES ALIGN : 64 :: U, Vt, D !DIR$ ATTRIBUTES ALIGN : 64 :: U, Vt, D
integer :: info, i, j integer :: info, i, j
double precision :: local_cutoff
if (n < 2) then if (n < 2) then
return return
@ -772,13 +774,14 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m,cutoff)
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(:)) D(:) = dsqrt(D(:))
local_cutoff = dsqrt(cutoff)*D(1) ! such that D(i)/D(1) > dsqrt(cutoff) is kept
m=n m=n
do i=1,n do i=1,n
if ( D(i) >= cutoff ) then if ( D(i) >= local_cutoff ) then
D(i) = 1.d0/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:', local_cutoff
exit exit
endif endif
enddo enddo
@ -786,12 +789,6 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m,cutoff)
D(i) = 0.d0 D(i) = 0.d0
enddo enddo
do i=1,m
if ( D(i) >= 1.d5 ) then
print *, 'Warning: Basis set may have linear dependence problems'
endif
enddo
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)
@ -907,7 +904,8 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m,cutoff)
double precision, allocatable :: Vt(:,:) double precision, allocatable :: Vt(:,:)
double precision, allocatable :: D(:) double precision, allocatable :: D(:)
double precision, allocatable :: S(:,:) double precision, allocatable :: S(:,:)
integer :: info, i, j, k integer :: info, i, j, k, mm
double precision :: local_cutoff
if (n < 2) then if (n < 2) then
return return
@ -916,24 +914,28 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m,cutoff)
allocate(U(ldc,n),Vt(lda,n),S(lda,n),D(n)) allocate(U(ldc,n),Vt(lda,n),S(lda,n),D(n))
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(:))
!$OMP PARALLEL DEFAULT(NONE) & local_cutoff = dsqrt(cutoff)*D(1) ! such that D(i)/D(1) > dsqrt(cutoff) is kept
!$OMP SHARED(S,U,D,Vt,n,C,m,cutoff) & mm=n
!$OMP PRIVATE(i,j,k)
!$OMP DO
do i=1,n do i=1,n
if ( D(i) < cutoff ) then if ( D(i) >= local_cutoff) then
print *, 'Removed Linear dependencies :', 1.d0/D(i) D(i) = 1.d0/D(i)
D(i) = 0.d0
else else
D(i) = 1.d0/dsqrt(D(i)) mm = mm-1
D(i) = 0.d0
endif endif
do j=1,n do j=1,n
S(j,i) = 0.d0 S(j,i) = 0.d0
enddo enddo
enddo enddo
!$OMP END DO
if (mm < n) then
print *, 'Removed Linear dependencies below ', local_cutoff
endif
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(S,U,D,Vt,n,C,m,cutoff) &
!$OMP PRIVATE(i,j,k)
do k=1,n do k=1,n
if (D(k) /= 0.d0) then if (D(k) /= 0.d0) then