Discussion :

[Cuve9]

Salut, j'ai une erreur dont je n'arrive pas du tout à trouver l'origine...
Il s'agit de l'erreur suivante : Array 'qqq' at (1) cannot have a deferred shape
Pour y voir plus clair je vous met en pièce jointe, une partie des erreurs que me renvoie le compilateur.

Voilà également le code correspondant (c'est pour une décomposition QR) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
subroutine decomposition_QR(A,QQQ,RR)
 
  real, dimension(:,:), intent(in)  :: A
  real, dimension(:,:), intent(out) :: QQQ,RR
  real, dimension(:,:) :: H
  real, dimension(:) :: v
  real :: alpha,beta,gamma, dd
  integer :: i,j,k,taille
  integer :: pballocation
 
taille=size(A,1)
alpha=0
beta=0
gamma=0
dd=0
 
     if(.not. allocated(QQQ)) then
        allocate(QQQ(taille,taille), stat=pballocation )
        if(pballocation .GT. 0) then
           stop " Erreur: probleme memoire "   
         end if
    end if
 
     if(.not. allocated(RR)) then
        allocate(RR(taille,taille), stat=pballocation )
        if(pballocation .GT. 0) then
           stop " Erreur: probleme memoire "   
         end if
    end if
 
     if(.not. allocated(v)) then
        allocate(v(1,taille), stat=pballocation )
        if(pballocation .GT. 0) then
           stop " Erreur: probleme memoire "   
        end if
     end if
 
     if(.not. allocated(H)) then
        allocate(H(taille,taille ),stat=pballocation )
        if(pballocation .GT. 0) then
           stop " Erreur: probleme memoire "   
        end if
     end if
 
 
 
 
!On initialise la matrice H, en prenant 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
 
 
do k=1,taille-1
  alpha=0
  beta=0
  gamma=0
  dd=0
   do i=k,taille
      alpha=alpha+(A(i,k)*A(i,k))
   end do
   alpha=sqrt(alpha)
   beta=(alpha*alpha)-(alpha*A(k,k))
 
   !Construction du vecteur v
   v(1,k)=A(k,k)-alpha
   do i=k+1,taille
      v(1,i)=A(i,k)
   end do
 
   do j=k,taille 
      ! Construction de la matrice A**(k+1)     
      do i=k,taille
         gamma=gamma+(v(1,i)*A(i,j))
      end do
      gamma=gamma*(1/beta)
      do i=k,taille
         A(i,j)=A(i,j)-(gamma*v(1,i))
      end do
   end do
 
   do j=1,taille
      !Construction de H
      do i=k,taille
        dd=dd+(v(1,i)*H(i,j))
      end do
      dd=dd*(1/beta)
      do i=k,taille 
         H(i,j)=H(i,j)-(dd*v(1,i))
      end do
   end do
end do
 
do i=1,taille
   do j=1,taille
       H(i,j)=H(j,i) !! calcul de la transposée
   end do
end do
 
QQQ=H
 
write(*,*)
write(*,"(' Q:')")
do i=1,taille
   write(*,*) QQQ(i,:)
end do
 
 
RR=A
 
write(*,*)
write(*,"('R:')")
do i=1,taille
   write(*,*) RR(i,:)
end do
 
return
end subroutine decomposition_QR

Merci pour votre aide !

Respectueusement.

[__dardanos__]

Salut,
Il y avait un souci sur les vocations et l'allocation dynamique. Maintenant le sous programme compile.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
subroutine decomposition_QR ( A, QQQ, RR )
    implicit none
    real, dimension(:,:), intent(inout)  :: A
    real, dimension(:,:), intent(out) :: QQQ, RR
    real, dimension(:,:), allocatable :: H
    real, dimension(:), allocatable :: v
    real :: alpha,beta,gamma, dd
    integer :: i,j,k,taille
    integer :: pballocation
 
    taille=size(A,1)
    alpha=0
    beta=0
    gamma=0
    dd=0
 
    if(.not. allocated(v)) then
        allocate(v(taille), stat=pballocation )
        if(pballocation .GT. 0) stop " Erreur: probleme memoire "
    end if
 
    if(.not. allocated(H)) then
        allocate(H(taille,taille ),stat=pballocation )
        if(pballocation .GT. 0) stop " Erreur: probleme memoire "
    end if
 
    !On initialise la matrice H, en prenant 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
 
 
    do k=1,taille-1
      alpha=0
      beta=0
      gamma=0
      dd=0
       do i=k,taille
          alpha=alpha+(A(i,k)*A(i,k))
       end do
       alpha=sqrt(alpha)
       beta=(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
             gamma = gamma + v(i) * A(i,j)
          end do
          gamma=gamma*(1/beta)
          do i=k,taille
             A(i,j) = A(i,j) - gamma * v(i)
          end do
       end do
 
       do j=1,taille
          !Construction de H
          do i=k,taille
            dd=dd+(v(i)*H(i,j))
          end do
          dd=dd*(1/beta)
          do i=k,taille
             H(i,j)=H(i,j)-(dd*v(i))
          end do
       end do
    end do
 
    do i=1,taille
       do j=1,taille
           H(i,j)=H(j,i) !! calcul de la transposée
       end do
    end do
 
    QQQ=H
 
    write(*,*)
    write(*,"(' Q:')")
    do i=1,taille
       write(*,*) QQQ(i,:)
    end do
 
 
    RR=A
 
    write(*,*)
    write(*,"('R:')")
    do i=1,taille
       write(*,*) RR(i,:)
    end do
 
    deallocate(v,H)
 
end subroutine decomposition_QR

[Cuve9]

Merci Dardanos, j'avais également oublié de mettre allocatable dans la déclaration de QQQ et de RR dans mon main.. Mais du coup maintenant lorsque je lance le programme, j'ai un segmentation fault...

Merci encore !

[Cuve9]

Est que quelqu'un aurait une idée concernant l'origine de l'apparition de l'erreur segmentation fault ?

Merci

[__dardanos__]

Salut,
Les tableaux A, QQQ et RR doivent être alloués avant l'appel du sous programme decomposition_QR. Il ne suffit pas de les déclarer comme "allocatable" dans le programme principal.

Vérifie aussi le calcul de la transposée de H, je pense qu'il y a une erreur.

[Cuve9]

Merci Dardanos, encore une fois tu as vu juste ! Ce qui est étrange c'est que je fais appelle plusieurs fois à des subroutines qui renvoient des tableaux et que ces tableaux sont alloués dans mes subroutines sans avoir eu à les allouer avant l'appelle de la subroutine, et je n'ai jamais eu de problèmes...

En ce qui concerne la transposé j'ai mis :

do i=1,taille
do j=1,taille
int_H=H(i,j)
int_H_bis=H(j,i)
H(i,j)=int_H_bis
H(j,i)=int_H
end do
end do

et ça marche nickel

merci encore !

[LittleOwl]

Bonjour,

Je pense qu'il y a toujours une erreur dans le calcul de la transposée de H.

On peut s'en rendre compte en effectuant le test suivant :

Soit la matrice 2 X 2 non symétrique H = ( (1, 2), (3, 4) ). Votre code conduit à Transpose(H) = H, ce qui est manifestement faux.

L'erreur vient du fait que le code échange 2 fois chaque élément de la matrice avec son symétrique par rapport à la diagonale car la boucle sur j démarre à 1.

Dans le code ci-dessous, la borne inférieure de la boucle sur j a été modifiée de manière à ne travailler que sur le triangle supérieur de la matrice, ce qui donne le bon résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
...
real :: tmp
...
! Calcul de la transposee de H
 
do i = 1, taille - 1
  do j = i+1, taille
	tmp = H(j,i); H(j,i) = H(i,j); H(i,j) = tmp 
  end do
end do