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