1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
| subroutine decomposition_QR(A,Q,R)
real, dimension(:,:), intent(inout) :: A,Q,R
real, dimension(3,3) :: H
real, dimension(3) :: v
real :: alpha,b,c,d
integer :: i,j,k,taille
alpha=0
b=0
c=0
d=0
taille=3 !size(A)
!-----Initialisation de la matrice H, H=I------
do i=1,taille
do j=1,taille
if( i .EQ. J) then
H(i,j) = 1
else
H(i,j) = 0
end if
end do
end do
write(*,*)H
!-----------------------------------------------
!----Debut-----
do k=1,taille-1
do i=k,taille
alpha=alpha+(A(i,k)*A(i,k))
end do
alpha=sqrt(alpha)
b=(alpha*alpha)-(alpha*A(k,k))
!---Construction du vecteur v
v(k)=A(k,k)-alpha
do i=k+1,taille
v(i)=A(i,k)
end do
do j=k,taille
!---Construction de la matrice A**(k+1)----
do i=k,taille
c=c+(v(i)*A(i,j))
end do
c=c*(1/b)
do i=k,taille
A(i,j)=A(i,j)-(c*v(i))
end do
end do
do j=1,taille
!---Construction de H = Hk x ... x H2 x H1
do i=k,taille
d=d+(v(i)*H(i,j))
end do
d=d*(1/b)
do i=k,taille
H(i,j)=H(i,j)-(d*v(i))
end do
end do
end do
!---Fin----------
Q=transpose(H)
R=matmul(H,A)
end subroutine decomposition_QR |
Partager