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:
parent
8fdd44c6f0
commit
ae01d339df
@ -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.
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user