From aeed0f7f3b9740d5b42595f3b6f54edd467119d9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 23 Dec 2020 02:45:20 +0100 Subject: [PATCH] Fixed svd --- src/utils/linear_algebra.irp.f | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f index d858341d..c3b7be79 100644 --- a/src/utils/linear_algebra.irp.f +++ b/src/utils/linear_algebra.irp.f @@ -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