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 |
