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 |
Partager