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
|
open(UNIT=7,FILE='sortie.txt',status='NEW')
OPEN(unit=20, file='test.txt')
read(20,*)read_value
ma=read_value
mi=read_value
close(20)
OPEN(unit=20,file='test.txt')
ios = 0
nb_val= 0
do while (.true.)
read(unit=20,fmt=*,iostat=ios) read_value
if (ios .ne. 0) exit
nb_val = nb_val + 1 !nombre de valeur
if(read_value.gt.ma)then
ma=read_value ! Maximal
endif
if(read_value.lt.mi)then
mi=read_value ! Minimun
endif
enddo
endfile(20)
rewind (20 )
b_klasse =15
C!!!!!!!!!!!! distance entre les classe!!!!!!!!!!
distance=ANINT((ma -mi)/ b_klasse+0.5)
open(UNIT=13,FILE='inter.txt', status='NEW' , access='direct',
1 form='unformatted', recl=nb_valeur)
OPEN(unit=20, file='test.txt')
ios = 0
do while (.true.)
read(unit=20,fmt=*,iostat=ios) read_value
if (ios .ne. 0) exit
wert_bear= ANINT(((read_value-mi)/abstand)+0.5)
write(13,rec=a)wert_bear
a=a+1
end do
close(20)
m= nb_val
a=1
do while(i.lt.m )
do j=1, 4
read(13,rec=a)read_value
zahl(j)=read_value
a=a+1
end do
if (test(zahl,k).eq.1.0) then
write(7,*) zahl(2)
write(7,*) zahl(3)
do while (i+2.le.m) ! supression des valeurs i+1 et i+2
read(13,rec=i+3)read_value
write(13,rec=i+1) read_value
i=i+1
end do
m=m-2
i=1
else
i=i+1
end if
end do
close(13,status='delete')
close(7,status='keep')
end
real function test(ein, h)
implicit none
real ein(10),aus
integer h
if (ein(h).ge.ein(h+1))then
if (ein(h).ge.ein(h+2)) then
if (ein(h+3).le.ein(h+2)) then
if(ein(h+3).le.ein(h+1)) then
aus=1.0
endif
endif
endif
else
if (ein(h+3).ge.ein(h+1))then
if (ein(h+3).ge.ein(h+2)) then
if (ein(h).le.ein(h+2)) then
if(ein(h).le.ein(h+1)) then
aus=1.0
endif
endif
endif
else
aus=0.0
end if
end if
if (ein(h+1).eq.ein(h+2))then
aus=0
end if
test=aus
return
end |
