PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 21:03:49 +01:00
Code Releases Activity

complex qr

Browse Source
This commit is contained in:
Kevin Gasperich 2020-02-25 16:19:07 -06:00
parent f869d347b8
commit 102d930452
1 changed files with 48 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -167,7 +167,7 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m)
end end
subroutine ortho_qr_complex(A,LDA,m,n) subroutine ortho_qr_complex_old(A,LDA,m,n)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Orthogonalization using Q.R factorization ! Orthogonalization using Q.R factorization
@ -199,6 +199,45 @@ subroutine ortho_qr_complex(A,LDA,m,n)
deallocate(WORK,jpvt,tau) deallocate(WORK,jpvt,tau)
end end
subroutine ortho_qr_complex(A,LDA,m,n)
implicit none
BEGIN_DOC
! Orthogonalization using Q.R factorization
!
! A : matrix to orthogonalize
!
! LDA : leftmost dimension of A
!
! n : Number of columns? of A
!
! m : Number of rows? of A
!
END_DOC
integer, intent(in) :: m,n, LDA
complex*16, intent(inout) :: A(LDA,n)
integer :: lwork, info
complex*16, allocatable :: tau(:), work(:)
allocate(tau(n), work(1))
lwork=-1
call zgeqrf( m, n, A, LDA, tau, work, lwork, info )
lwork=int(work(1))
deallocate(work)
allocate(work(lwork))
call zgeqrf(m, n, A, LDA, tau, work, lwork, info )
deallocate(work)
lwork=-1
allocate(work(1))
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
lwork=int(work(1))
deallocate(work)
allocate(work(lwork))
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
deallocate(work,tau)
end
subroutine ortho_qr_unblocked_complex(A,LDA,m,n) subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -208,25 +247,21 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
! !
! LDA : leftmost dimension of A ! LDA : leftmost dimension of A
! !
! n : Number of rows of A ! n : Number of columns of A
! !
! m : Number of columns of A ! m : Number of rows of A
! !
END_DOC END_DOC
integer, intent(in) :: m,n, LDA integer, intent(in) :: m,n, LDA
double precision, intent(inout) :: A(LDA,n) complex*16, intent(inout) :: A(LDA,n)
integer :: info integer :: info
integer, allocatable :: jpvt(:) complex*16, allocatable :: tau(:), work(:)
double precision, allocatable :: tau(:), work(:)
print *, irp_here, ': TO DO' allocate(tau(n),work(n))
stop -1 call zgeqr2(m,n,A,LDA,tau,work,info)
call zung2r(m,n,n,A,LDA,tau,work,info)
! allocate (jpvt(n), tau(n), work(n)) deallocate(work,tau)
! call dgeqr2( m, n, A, LDA, TAU, WORK, INFO )
! call dorg2r(m, n, n, A, LDA, tau, WORK, INFO)
! deallocate(WORK,jpvt,tau)
end end
subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m) subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m)