QR decomposition: Difference between revisions
Content deleted Content added
m →Jama |
|||
Line 1,478: | Line 1,478: | ||
implicit none |
implicit none |
||
integer, parameter :: n = 4 |
integer, parameter :: n = 4 |
||
real(8) :: durer(n, n) = reshape([ |
real(8) :: durer(n, n) = reshape(dble([ & |
||
16, 5, 9, 4, & |
|||
3, 10, 6, 15, & |
|||
2, 11, 7, 14, & |
|||
13, 8, 12, 1 & |
|||
]), [n, n]) |
|||
real(8) :: q(n, n), r(n, n), qr(n, n), id(n, n), tau(n) |
real(8) :: q(n, n), r(n, n), qr(n, n), id(n, n), tau(n) |
||
integer, parameter :: lwork = 1024 |
integer, parameter :: lwork = 1024 |
||
real(8) :: work(lwork) |
real(8) :: work(lwork) |
||
integer :: info, i, j |
integer :: info, i, j |
||
q = durer |
q = durer |
||
call dgeqrf(n, n, q, n, tau, work, lwork, info) |
call dgeqrf(n, n, q, n, tau, work, lwork, info) |
||
r = 0d0 |
r = 0d0 |
||
forall (i = 1:n, j = 1:n, j >= i) r(i, j) = q(i, j) |
forall (i = 1:n, j = 1:n, j >= i) r(i, j) = q(i, j) |
||
call dorgqr(n, n, n, q, n, tau, work, lwork, info) |
call dorgqr(n, n, n, q, n, tau, work, lwork, info) |
||
qr = matmul(q, r) |
qr = matmul(q, r) |
||
id = matmul(q, transpose(q)) |
id = matmul(q, transpose(q)) |
||
call show(4, durer, "A") |
call show(4, durer, "A") |
||
call show(4, q, "Q") |
call show(4, q, "Q") |
||
Line 1,508: | Line 1,510: | ||
integer :: n, i |
integer :: n, i |
||
real(8) :: a(n, n) |
real(8) :: a(n, n) |
||
print *, s |
print *, s |
||
do i = 1, n |
do i = 1, n |
||
print 1, a(i, :) |
print 1, a(i, :) |
||
1 format (*( |
1 format (*(f12.6,:,' ')) |
||
end do |
end do |
||
end subroutine |
end subroutine |