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

DGEMM in pseudo-inverse
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
Anthony Scemama 2024-02-12 18:21:59 +01:00
parent 1b9a75f488
commit d619c621fc
1 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1377,29 +1377,29 @@ subroutine get_pseudo_inverse(A, LDA, m, n, C, LDC, cutoff)
enddo enddo
endif endif
! !$OMP PARALLEL & !$OMP PARALLEL &
! !$OMP DEFAULT (NONE) & !$OMP DEFAULT (NONE) &
! !$OMP PRIVATE (i, j) & !$OMP PRIVATE (i, j) &
! !$OMP SHARED (n, n_svd, D, Vt) !$OMP SHARED (n, n_svd, D, Vt)
! !$OMP DO !$OMP DO
! do j = 1, n do j = 1, n
! do i = 1, n_svd do i = 1, n_svd
! Vt(i,j) = D(i) * Vt(i,j) Vt(i,j) = D(i) * Vt(i,j)
! enddo
! enddo
! !$OMP END DO
! !$OMP END PARALLEL
! call dgemm('N', 'N', n, m, n_svd, 1.d0, Vt, size(Vt,1), U, size(U,1), 0.d0, C, size(C,1))
C = 0.d0
do i=1,m
do j=1,n
do k=1,n_svd
C(j,i) = C(j,i) + U(i,k) * D(k) * Vt(k,j)
enddo
enddo enddo
enddo enddo
!$OMP END DO
!$OMP END PARALLEL
call dgemm('T', 'T', n, m, n_svd, 1.d0, Vt, size(Vt,1), U, size(U,1), 0.d0, C, size(C,1))
! C = 0.d0
! do i=1,m
! do j=1,n
! do k=1,n_svd
! C(j,i) = C(j,i) + U(i,k) * D(k) * Vt(k,j)
! enddo
! enddo
! enddo
deallocate(U,D,Vt,work,A_tmp) deallocate(U,D,Vt,work,A_tmp)