PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-19 04:22:32 +01:00
Code Releases Activity

Fixed svd

Browse Source
This commit is contained in:
Anthony Scemama 2020-12-23 02:45:20 +01:00
parent ffc909eb09
commit a97ca302c7
1 changed files with 7 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/utils/linear_algebra.irp.f
View File

@ -44,7 +44,7 @@ subroutine svd(A,LDA,U,LDU,D,Vt,LDVt,m,n)
stop stop
endif endif
do j=1,m do j=1,min(m,n)
do i=1,m do i=1,m
if (dabs(U(i,j)) < 1.d-14) U(i,j) = 0.d0 if (dabs(U(i,j)) < 1.d-14) U(i,j) = 0.d0
enddo enddo
@ -1123,7 +1123,12 @@ subroutine ortho_svd(A,LDA,m,n)
double precision, allocatable :: U(:,:), D(:), Vt(:,:) double precision, allocatable :: U(:,:), D(:), Vt(:,:)
allocate(U(m,n), D(n), Vt(n,n)) allocate(U(m,n), D(n), Vt(n,n))
call SVD(A,LDA,U,size(U,1),D,Vt,size(Vt,1),m,n) call SVD(A,LDA,U,size(U,1),D,Vt,size(Vt,1),m,n)
A(1:m,1:n) = U(1:m,1:n) integer :: i,j
do j=1,n
do i=1,m
A(i,j) = U(i,j)
enddo
enddo
deallocate(U,D, Vt) deallocate(U,D, Vt)
end end