10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 20:34:58 +01:00

Fixed svd

This commit is contained in:
Anthony Scemama 2020-12-23 02:45:20 +01:00
parent 239ba03231
commit aeed0f7f3b

View File

@ -40,7 +40,7 @@ subroutine svd(A,LDA,U,LDU,D,Vt,LDVt,m,n)
stop
endif
do j=1,m
do j=1,min(m,n)
do i=1,m
if (dabs(U(i,j)) < 1.d-14) U(i,j) = 0.d0
enddo
@ -1119,7 +1119,12 @@ subroutine ortho_svd(A,LDA,m,n)
double precision, allocatable :: U(:,:), D(:), Vt(:,:)
allocate(U(m,n), D(n), Vt(n,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)
end