Discussion :

[MegaNam]

Bonjour,

J'ai fait un code qui à partir d'un tableau de points donnent les voisins de chaque points et les regroupe. Mais le pb est que lorsque j'ai fait du code une subroutine le tableau de points ne se transmet pas et je ne comprends pas pourquoi.
Je vous mets le code ça fait 2 jours que je bataille avec deja.

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
program test_voisin
implicit none
integer :: dim,i
real*8 :: x
integer, dimension (10) :: points
integer, dimension (:,:), allocatable :: mat
dim=10
allocate (mat(dim,dim))
call random_seed
do i = 1,10
call random_number (x)
x=2*10*x-1
points(i)=x
enddo
print*, points
pause 100
call connexion (points,mat,dim)

end program test_voisin

subroutine connexion (points,mat,dim)

implicit none
integer :: dim
real*8 , dimension (dim) :: points
real*8,dimension (:), allocatable :: t1
integer , dimension (dim,dim) :: mat
integer , dimension (:)   ,  allocatable  :: l1,l2,l3 
integer , dimension (:)   ,  allocatable  :: vois
logical test
integer i,j,k
integer ifus,iv1,iv2,iv3
real*8 x,y,z,t
real*8 eps,larg
dim=10
open(10,file='depart.dat',status='unknown')
allocate(t1(dim))
allocate(vois(dim))
allocate(l1(dim))
allocate(l2(dim))
allocate(l3(dim))
print*, 'deuxieme verification', points
2 write(6,*) 'critere de distance entre points'
read(5,*) eps
mat=0
l1=0
l2=0
l3=0
vois=0
do i=1,dim
k=0
do j=1,dim
if(abs(points(i)-points(j)).le.eps) then
k=k+1
mat(i,k)=j
endif
enddo
vois(i)=k
enddo

do i=1,dim
write(6,*) (mat(i,j),j=1,vois(i))
enddo

do while(.true.)
ifus=0
do i=1,dim
do j=1,dim
if(i.eq.j) cycle
l1=mat(i,:)
l2=mat(j,:)
iv1=vois(i)
iv2=vois(j)
if(iv1*iv2.eq.0) cycle
call intersection(l1,l2,l3,iv1,iv2,iv3,dim,test)
if(test.eq..false.) cycle
mat(i,:)=l3
vois(i)=iv3
mat(j,:)=0
vois(j)=0
ifus=1
enddo
enddo
if(ifus.eq.0) exit

enddo

write(6,*) 'termine'
k=0
do i=1,dim
if(vois(i).eq.0) cycle
k=k+1
write(6,1) k,vois(i)
1 format( 'l''ensemble de points numero ',i4,' contient les ',i4,' points suivants :')
write(6,*) (mat(i,j),j=1,vois(i))
write(6,*)
enddo

rewind(10)
do i=1,dim
x=1.d0
write(10,*) points(i),x
enddo


do i=1,dim
if(vois(i).eq.0) cycle
do j=1,vois(i)
t1(j)=points(mat(i,j))
enddo
y=minval(t1(1:vois(i)))
z=maxval(t1(1:vois(i)))
t=y
x=2.d0
do while(t.le.z)
write(10,*) t,x
t=t+eps/1000.d0
enddo
x=3.d0
write(10,*) (y+z)/2.d0,x
enddo

go to 2

end subroutine connexion
subroutine intersection(l1,l2,l3,iv1,iv2,iv3,dim,test)
integer , intent(in) :: dim
integer iv3,k,i,j
integer l3(dim)
integer , intent(in) :: l1(dim),l2(dim)
integer, intent(in) ::  iv1,iv2
logical test
test=.false.
do i=1,iv1
do j=1,iv2
if(l1(i).eq.l2(j)) then
test=.true.
endif
enddo
enddo
if(test.eq..false.) return
l3=l1
k=iv1
do i=1,iv2
do j=1,iv1
if(l3(j).eq.l2(i)) go to 1
enddo
k=k+1
l3(k)=l2(i)
1 continue
enddo
iv3=k
return
end subroutine intersection

Lors de la verification de la transmission du tableau points il ne me donne pas les valeurs trouvées précédements mais juste 0 ou un nombre en 10^(-313).

Merci de votre aide

[MegaNam]

En fait j'ai deja trouvé mon erreur dans la subroutine je n'avais pas défini le tableau points comme un tableau integer il faut definir de la meme façon dans le corps du programme et dans la subroutine le tableau.

suffit de poster pour trouver son erreur