Problème de subroutine

**Cuve9** · 30/04/2013, 13h47

Bonjour tout le monde,

Alors voilà j'ai des petits soucis avec mes subroutine... Dans un premier temps, j'ai écris mon code sans utilisation de procédures puis après avoir tout écrit, j'ai décomposé mon algo en plusieurs subroutines.

Il s'agit d'un algo qui enregistre les résultats d'un sondage et qui construit différents tableaux à partir de ces résultats (tableau de contingence, tableau dénombrant le nombre de réponses..)

Je met également en pièce jointe les erreurs que me renvoie l'exécutable.

Voilà ce que ça donne avec les subroutines :

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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
program resultatsondagebis
 
implicit none
 
 
call system("clear")
 
 
call Entrerparametres(p,q,n)
 
 
write(*,*)
write(*,*)
write(*,"('Etape 1 : Construction du tableau R contenant les resultats du sondage effectue sur ',i5,4x,'personnes')",advance='no') n
write(*,*) 
 
call Tableauresultat(R,p,q,n)
 
write(*,*)
write(*,*)
 
write(*,"('Etape 2 : Construction du tableau de contingence C')",advance='no')
write(*,*)
 
call Tableaucontingence(C,R,p,q,n)
 
write(*,*)
write(*,*)
write(*,"('Etape 3: Construction des vecteurs CL et CC.')",advance='no')
write(*,*)
 
write(*,*)
write(*,"('Avec les elements CLi de CL correspondant a la sommes des effectifs des personnes ayant repondu i a Q1 et &
les elements CCj de CC correspondant a la somme des effectifs des personnes ayant repondues j a Q2.')",advance='no')
write(*,"(' Donc les CLi coorespondent a la somme des colonnes de C et &
&les CCj correspondent a la somme des lignes de C.')",advance='no')
write(*,*)
 
call TableauxSommeEffectif(CL,CC,C,p,q,n)
 
write(*,*)
write(*,*)
write(*,"('Etape 4: Determination de l''ecart existant entre chaque effectif de C et une valeur theorique')")
write(*,*)
write(*,"('La valeur theorique est l''effectif qu''il devrait y avoir dans chaque case si tout le monde &
& repondait de facon parfaitement repartie entre toutes les possibilites. Dans ce cas il y alors &
&independance parfaite entre l''attribution des modalites de Q1 et de Q2')")
 
call TableauEcartTheo(Ctheo,Ecarts,p,q,n,C,CL,CC)
 
 
stop 'fin'
 
 
contains
 
subroutine Entrerparametres(p,q,n)
integer, intent(out) :: p,q,n
integer ::IO_ERROR
 
write(*,"('Veuillez entrer le nombre de reponses possibles pour la Q1(format i5) :')",advance='no');
do
read(*,IOSTAT=IO_ERROR,FMT="(i5)") p
if(IO_ERROR .EQ. 0) exit
write(*,"('Entree incorecte, entrer un reel en format i5. Merci.')",advance='no')
end do
 
do while ((p.EQ.0).OR.(p.LT.0))
   write(*,"('Erreur : le nombre de modalites pour Q1 ne peut pas etre inferieur ou egal a zero. &
&Veuillez entrer un nombre de modalites strictement positif. p=')",advance='no')
   do
   read(*,IOSTAT=IO_ERROR,FMT="(i5)") p
   if (IO_ERROR .EQ. 0) exit
write(*,"('Entree incorecte, entrer un reel en format i5. Merci.')",advance='no')
   end do
end do
 
write(*,"('Veuillez entrer le nombre de reponses possibles pour la Q2 (format i5) : ')",advance='no');
do
read(*,IOSTAT=IO_ERROR,FMT="(i5)") q
if (IO_ERROR .EQ. 0) exit
write(*,"('Entree incorecte, entrer un reel en format i5. Merci.')",advance='no')
end do
 
do while ((q.EQ.0).OR.(q.LT.0))
   write(*,"('Erreur : le nombre de modalites pour Q2 ne peut pas etre inferieur ou egal a zero. &
&Veuillez entrer un nombre de modalites strictement positif. q=')",advance='no')
   do
   read(*,IOSTAT=IO_ERROR,FMT="(i5)") q
   if (IO_ERROR .EQ. 0) exit
write(*,"('Entree incorecte, entrer un reel en format i5. Merci.')",advance='no')
   end do
end do
 
write(*,"('Veuillez entrer le nombre de personnes interrogees (format i5) : ')",advance='no'); 
do
read(*,IOSTAT=IO_ERROR,FMT="(i5)") n
if (IO_ERROR .EQ. 0) exit
write(*,"('Entree incorecte, entrer un reel en format i5. Merci.')",advance='no')
end do
 
do while ((n.EQ.0).OR.(n.LT.0))
   write(*,"('Erreur : La taille de l''echantillon ne peut pas etre inferieur ou egal a zero. &
&Veuillez entrer un nombre de modalites strictement positif. n=')",advance='no')
   do
   read(*,IOSTAT=IO_ERROR,FMT="(i5)") n
   if (IO_ERROR .EQ. 0) exit
write(*,"('Entree incorecte, entrer un reel en format i5. Merci.')",advance='no')
   end do
end do
 
write(*,*)
write(*,"('Le nombre de modalites entrees pour Q1 est : ',x,'p=',x,i5)",advance='no') p
write(*,*)
write(*,"('Le nombre de modalites entrees pour Q2 est : ',x,'q=',x,i5)",advance='no') q
write(*,*)
write(*,"('Le nombre de personnes interrogees  est : ',x,'n=',x,i5)",advance='no') n
write(*,*)
 
return
end subroutine Entrerparametres
 
 
subroutine Tableauresultat(R,p,q,n)
integer, intent(in) :: p,q,n
integer, dimension(:,:), allocatable, intent(out) :: R
integer :: i
integer :: pballocation
 
if(.not. allocated(R)) then
  allocate( R(n,2),stat=pballocation )
  if(pballocation .GT. 0) then
     stop " Erreur: probleme memoire "   
  end if
end if
 
do i=1,n
   R(i,1)=floor(rand() * p)+1
   R(i,2)=floor(rand()*q)+1
end do
 
write(*,*)
write(*,"('Le resulat du sondage est : ')",advance='no')
write(*,*)
 
write(*,"(8x,'Q1',13x,'Q2')")
 
do i=1,n
write(*,*) R(i,:)
end do
 
return
 
end subroutine Tableauresultat
 
 
subroutine Tableaucontingence(C,R,p,q,n)
integer, intent(in) :: p,q,n
integer, dimension(:,:), allocatable, intent(in) :: R
integer, dimension(:,:), allocatable, intent(out):: C
integer :: i,j
integer :: pballocation
 
if(.not. allocated(C)) then
  allocate( C(p,q),stat=pballocation )
  if(pballocation .GT. 0) then
     stop " Erreur: probleme memoire "   
  end if
end if
 
do i=1,p
   do j=1,q
      C(i,j)=0  !! Initialisation du tableau de contingence avec des zéros partout
   end do
end do
 
do i=1,n
   C(R(i,1),R(i,2))=C(R(i,1),R(i,2))+1
end do 
 
write(*,*)
write(*,"('Voici le tableau de contingence C :')",advance='no')
write(*,*)
 
do i=1,p
write(*,*) C(i,:)
end do
 
write(*,*)
write(*,"('Remarque : chaque case Cij correspond au nombre de personnes ayant repondues a la fois i a Q1 ET j a Q2.')",advance='no')
write(*,*)
write(*,"('Exemple: pour cette etude le nombre de personne ayant repondu',x,i5,3x,'a Q1 et'x,i5,3x,'a Q2 est de :'x,i5)") p,q,C(p,q)
 
return
end subroutine Tableaucontingence
 
 
subroutine TableauxSommeEffectif(CL,CC,C,p,q,n)
integer, intent(in) :: p,q,n
integer, dimension(:,:), allocatable, intent(in):: C
integer, dimension(:,:), allocatable, intent(out):: CL, CC
integer :: i,j
integer :: pballocation
 
if(.not. allocated(CL)) then
  allocate( CL(p,1),stat=pballocation )!! obligé de mettre CL(p,1) car erreur si je veux allouer le vecteur CL(p)...
  if(pballocation .GT. 0) then
     stop " Erreur: probleme memoire "   
  end if
end if
 
do i=1,p
      CL(i,1)=0  !! Initialisation du tableau de CL avec des zéros partout
end do
 
if(.not. allocated(CC)) then
  allocate( CC(1,q),stat=pballocation )
  if(pballocation .GT. 0) then
     stop " Erreur: probleme memoire "   
  end if
end if
 
 
do j=1,q
      CC(1,j)=0  !! Initialisation du tableau de contingence avec des zéros partout
end do
 
do i=1,p
   do j=1,q
      CL(i,1)=CL(i,1)+C(i,j)
      CC(1,j)=CC(1,j)+C(i,j)
   end do
end do
 
write(*,*)
write(*,"('Voici le vecteur CL :')",advance='no')
write(*,*)
 
do i=1,p
write(*,*) CL(i,1)
end do
 
write(*,*)
write(*,"('Remarque : chaque element CLi correspond a la somme des effectifs des personnes ayant repondues i a Q1.')",advance='no')
write(*,*)
 
write(*,*)
write(*,"('Voici le vecteur CC :')",advance='no')
write(*,*)
 
write(*,*) CC(1,:)
 
write(*,*)
write(*,"('Remarque : chaque element CCj correspond a la somme des effectifs des personnes ayant repondues j a Q2.')",advance='no')
write(*,*)
 
return
end subroutine TableauxSommeEffectif
 
 
subroutine TableauEcartTheo(Ctheo,Ecarts,p,q,n,C,CL,CC)
integer, intent(in):: p,q,n
integer, dimension(:,:), allocatable, intent(in):: C
integer, dimension(:,:), allocatable, intent(in):: CL, CC
real, dimension(:,:), allocatable, intent(out):: Ctheo
real, dimension(:,:), allocatable, intent(out):: Ecarts
integer :: i,j
integer :: pballocation
 
if(.not. allocated(Ctheo)) then
  allocate( Ctheo(p,q),stat=pballocation )
  if(pballocation .GT. 0) then
     stop " Erreur: probleme memoire "   
  end if
end if
 
do i=1,p
   do j=1,q
      Ctheo(i,j)=(CL(i,1)*CC(1,j))
      Ctheo(i,j)=Ctheo(i,j)/n
   end do
end do
 
write(*,*)
write(*,"('Le tableau des  effectifs theoriques est le suivant :')",advance='no')
write(*,*)
 
write(*,*)
write(*,"('Ctheo :')")
write(*,*)
 
do i=1,p
   write(*,*) Ctheo(i,:)
end do
 
allocate( Ecarts(p,q),stat=pballocation )
 
if(pballocation .GT. 0) then
   stop " Erreur: probleme memoire "   
end if
 
do i=1,p
   do j=1,q
     Ecarts(i,j)=C(i,j)-Ctheo(i,j)
   end do
end do
 
write(*,*)
write(*,"('Le tableau des ecarts entre l''effectif observe de C et les effectif theoriques Ctheo est le suivant :')",advance='no')
write(*,*)
 
write(*,*)
write(*,"('Ecarts :')")
write(*,*)
 
do i=1,p
   write(*,*) Ecarts(i,:)
end do
 
 
write(*,"('Lorsque Ecartsij est nul alors il y a independance entre Q1 et Q2. Lorsque Ecartsij alors les &
&ecarts sont dus, soit a des fluctuations aleatoires, ou soit dus a l''existence d''une dependance entre les deux questions.')")
 
return
end subroutine TableauEcartTheo
 
end program resultatsondagebis

Merci d'avance,

Bien à vous.

**Cuve9** · 30/04/2013, 13h57

J'ai trouvé mon erreur... J'ai déclaré mes variables dans les subroutines mais pas dans mon programme principale... Erreur d'inattention.

Bonne journée

Les modérateurs peuvent supprimer ce message. Merci

Problème de subroutine

Fortran

Discussions similaires

Partager

Partager