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
| programme main
character*10 CHAR
real*8 X
!
10 call INPUT (X,IERR)
if (IERR.eq.2) goto 20
if (IERR.eq.1 .or. IERR.eq.3) then
print *,'ERREUR -------------'
goto 10
end if
print *,'X ',X
!
20 end
!
! SOUS PROGRAMME "INPUT"
integer*2 function INPUT(VAL,IERR)
character*40 CHAINE
character*1 CAR
real*8 val,XINT,XDEC
IERR = 0
! On entre une chaine de caracteres et on sort un reel
! On tolere les chiffres le point et la virgule
! IERR = 0 si ok. IERR = 1 si erreur de caractere (lettre,espace,signes)
! IERR = 2 si pas d'entree
! IERR = 3 si trop de virgules ou de points
200 format (Q,A)
read (5,200) NCHAR,CHAINE
if (NCHAR .eq. 0) goto 902 ! RETURN seul
! Longueur de la chaine
I = len (CHAINE)
! ILEN = position du dernier caractere
do while (CHAINE(I:I) .eq. ' ')
I = I-1
end do
ILEN = I
!
NPV = 0 !nombre de point et de virgule
do I=1,ILEN
CAR = CHAINE (I:I)
ICAR = ichar (CAR)
! On tolere les caracteres virgule,point et les chiffres de 0 a 9
C if (CAR.eq.' ' .or. CAR.eq.',' .or. CAR.eq.'.') goto 10
if (CAR.eq.',' .or. CAR.eq.'.') goto 10
if (ICAR.ge.'30'X .and. ICAR.le.'39'X) goto 11
goto 901
10 NPV = NPV + 1
if (NPV .gt.1) goto 903 ! On admet 1 seul POINT ou VIRGULE
11 end do
! Position du POINT ou de la VIRGULE
IPOINT = index (CHAINE,'.')
IVIRGULE = index (CHAINE,',')
IM = max (IPOINT,IVIRGULE)
if (IM .ne. 0) then ! Traitement de la virgule ou point
!
100 format (E12.0)
! Conversion CHARACTERE en REEL
if (IM.eq.1) then
XINT=0. ! pas de valeur entiere
else
read (CHAINE (:IM-1),100) XINT
end if
read (CHAINE (IM+1:I),100) XDEC
! Mise a echelle des decimales
do J=1,(I-IM)
XDEC = XDEC/10.
end do
! Calcul de la valeur finale
VAL = XINT+XDEC
!
else
! Traitement de l'entier
read (CHAINE (:ILEN),100) VAL
end if
goto 999
!
901 print *,'erreur au caractere n°',I,' pour le carac
1tere *',CHAINE (I:I),'*'
IERR=1
goto 999
!
902 print *,'Pas d''entree'
IERR=2
goto 999
!
903 print *,'Trop de . ou de ,'
IERR=3
goto 999
!
999 return
end |
