QR decomposition: Difference between revisions
+Fortran (LAPACK)
(+Fortran (LAPACK)) |
|||
Line 1,469:
[[1], [2], [3]]</pre>
=={{header|Fortran}}==
{{libheader|LAPACK}}
<lang fortran>program qrtask
implicit none
integer, parameter :: n = 4
real(8) :: durer(n, n) = reshape([16d0, 5d0, 9d0, 4d0, &
3d0, 10d0, 6d0, 15d0, &
2d0, 11d0, 7d0, 14d0, &
13d0, 8d0, 12d0, 1d0], [n, n])
real(8) :: q(n, n), r(n, n), qr(n, n), id(n, n), tau(n)
integer, parameter :: lwork = 1024
real(8) :: work(lwork)
integer :: info, i, j
q = durer
call dgeqrf(n, n, q, n, tau, work, lwork, info)
r = 0d0
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)
qr = matmul(q, r)
id = matmul(q, transpose(q))
call show(4, durer, "A")
call show(4, q, "Q")
call show(4, r, "R")
call show(4, qr, "Q*R")
call show(4, id, "Q*Q'")
contains
subroutine show(n, a, s)
character(*) :: s
integer :: n, i
real(8) :: a(n, n)
print *, s
do i = 1, n
print 1, a(i, :)
1 format (*(F12.6,:,' '))
end do
end subroutine
end program</lang>
{{out}}
<pre> A
16.000000 3.000000 2.000000 13.000000
5.000000 10.000000 11.000000 8.000000
9.000000 6.000000 7.000000 12.000000
4.000000 15.000000 14.000000 1.000000
Q
-0.822951 0.376971 0.361447 -0.223607
-0.257172 -0.454102 -0.526929 -0.670820
-0.462910 -0.060102 -0.576283 0.670820
-0.205738 -0.805029 0.509510 0.223607
R
-19.442222 -10.904103 -10.595497 -18.516402
0.000000 -15.846152 -15.932298 -0.258437
0.000000 0.000000 -1.974168 -5.922505
0.000000 0.000000 0.000000 -0.000000
Q*R
16.000000 3.000000 2.000000 13.000000
5.000000 10.000000 11.000000 8.000000
9.000000 6.000000 7.000000 12.000000
4.000000 15.000000 14.000000 1.000000
Q*Q'
1.000000 -0.000000 -0.000000 0.000000
-0.000000 1.000000 0.000000 0.000000
-0.000000 0.000000 1.000000 -0.000000
0.000000 0.000000 -0.000000 1.000000</pre>
=={{header|Futhark}}==
| |||