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

Remove QR for CSFs because it does not work.

Browse Source
This commit is contained in:
v1j4y 2022-11-03 15:36:07 +01:00
parent 9ed77a0f9b
commit 90f78a9b78
1 changed files with 96 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1133,102 +1133,103 @@ subroutine ortho_svd(A,LDA,m,n)
end end
subroutine ortho_qr_withB(A,LDA,B,m,n) ! QR to orthonormalize CSFs does not work :-(
implicit none !subroutine ortho_qr_withB(A,LDA,B,m,n)
BEGIN_DOC ! implicit none
! Orthogonalization using Q.R factorization ! BEGIN_DOC
! ! ! Orthogonalization using Q.R factorization
! A : Overlap Matrix ! !
! ! ! A : Overlap Matrix
! LDA : leftmost dimension of A ! !
! ! ! LDA : leftmost dimension of A
! m : Number of rows of A ! !
! ! ! m : Number of rows of A
! n : Number of columns of A ! !
! ! ! n : Number of columns of A
! B : Output orthogonal basis ! !
! ! ! B : Output orthogonal basis
END_DOC ! !
integer, intent(in) :: m,n, LDA ! END_DOC
double precision, intent(inout) :: A(LDA,n) ! integer, intent(in) :: m,n, LDA
double precision, intent(inout) :: B(LDA,n) ! double precision, intent(inout) :: A(LDA,n)
! double precision, intent(inout) :: B(LDA,n)
!
! integer :: LWORK, INFO
! integer, allocatable :: jpvt(:)
! double precision, allocatable :: TAU(:), WORK(:)
! double precision, allocatable :: C(:,:)
! double precision :: norm
! integer :: i,j
!
! allocate (TAU(min(m,n)), WORK(1))
! allocate (jpvt(n))
! !print *," In function ortho"
! B = A
!
! jpvt(1:n)=1
!
! LWORK=-1
! call dgeqp3( m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
!
! ! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
! LWORK=max(n,int(WORK(1)))
!
! deallocate(WORK)
! allocate(WORK(LWORK))
! call dgeqp3(m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
! print *,A
! print *,jpvt
! deallocate(WORK,TAU)
! !stop
!
! !LWORK=-1
! !call dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO )
! !! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
! !LWORK=max(n,int(WORK(1)))
!
! !deallocate(WORK)
! !allocate(WORK(LWORK))
! !call dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO )
!
! !LWORK=-1
! !call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
! !! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
! !LWORK=max(n,int(WORK(1)))
!
! !deallocate(WORK)
! !allocate(WORK(LWORK))
! !call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
! !
! !allocate(C(LDA,n))
! !call dgemm('N','N',m,n,n,1.0d0,B,LDA,A,LDA,0.0d0,C,LDA)
! !norm = 0.0d0
! !B = 0.0d0
! !!print *,C
! !do i=1,m
! ! norm = 0.0d0
! ! do j=1,n
! ! norm = norm + C(j,i)*C(j,i)
! ! end do
! ! norm = 1.0d0/dsqrt(norm)
! ! do j=1,n
! ! B(j,i) = C(j,i)
! ! end do
! !end do
! !print *,B
!
!
! !deallocate(WORK,TAU)
!end
integer :: LWORK, INFO !subroutine ortho_qr_csf(A, LDA, B, m, n) bind(C, name="ortho_qr_csf")
integer, allocatable :: jpvt(:) ! use iso_c_binding
double precision, allocatable :: TAU(:), WORK(:) ! integer(c_int32_t), value :: LDA
double precision, allocatable :: C(:,:) ! integer(c_int32_t), value :: m
double precision :: norm ! integer(c_int32_t), value :: n
integer :: i,j ! integer(c_int16_t) :: A(LDA,n)
! integer(c_int16_t) :: B(LDA,n)
allocate (TAU(min(m,n)), WORK(1)) ! call ortho_qr_withB(A,LDA,B,m,n)
allocate (jpvt(n)) !end subroutine ortho_qr_csf
!print *," In function ortho"
B = A
jpvt(1:n)=1
LWORK=-1
call dgeqp3( m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
LWORK=max(n,int(WORK(1)))
deallocate(WORK)
allocate(WORK(LWORK))
call dgeqp3(m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
print *,A
print *,jpvt
deallocate(WORK,TAU)
!stop
!LWORK=-1
!call dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO )
!! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
!LWORK=max(n,int(WORK(1)))
!deallocate(WORK)
!allocate(WORK(LWORK))
!call dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO )
!LWORK=-1
!call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
!! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
!LWORK=max(n,int(WORK(1)))
!deallocate(WORK)
!allocate(WORK(LWORK))
!call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
!
!allocate(C(LDA,n))
!call dgemm('N','N',m,n,n,1.0d0,B,LDA,A,LDA,0.0d0,C,LDA)
!norm = 0.0d0
!B = 0.0d0
!!print *,C
!do i=1,m
! norm = 0.0d0
! do j=1,n
! norm = norm + C(j,i)*C(j,i)
! end do
! norm = 1.0d0/dsqrt(norm)
! do j=1,n
! B(j,i) = C(j,i)
! end do
!end do
!print *,B
!deallocate(WORK,TAU)
end
subroutine ortho_qr_csf(A, LDA, B, m, n) bind(C, name="ortho_qr_csf")
use iso_c_binding
integer(c_int32_t), value :: LDA
integer(c_int32_t), value :: m
integer(c_int32_t), value :: n
integer(c_int16_t) :: A(LDA,n)
integer(c_int16_t) :: B(LDA,n)
call ortho_qr_withB(A,LDA,B,m,n)
end subroutine ortho_qr_csf
subroutine ortho_qr(A,LDA,m,n) subroutine ortho_qr(A,LDA,m,n)
implicit none implicit none