[updated 23.May.2002]
Librairie redlib > Fichier redlec.f |
SUBROUTINE REDLEC (N)
Auteur : M.Lepareux (mis en forme par D.Martin)
Derniere modification : D.Martin (22 mai 2002)
Version 1.0.2
Lecture de donnees sous forme de chaine de caracteres ASCII
--> N est le type de la donnee que l'on cherche a lire :
N = 0 TITRE (la carte est lue et transmise sans etre analysee) ,
N = 1 ENTIER
N = 2 REEL
N = 4 MOT
N = 8 TEXTE
...... ou toute somme de ces valeurs , par exemple :
N = 3 ENTIER ou REEL
N =15 ENTIER ou REEL ou MOT ou TEXTE
--> Les resultats de la lecture transitent par COMMONs REDCO1 et REDCOM
--> Les articles (donnees) sont des chaines de caracteres ASCII et sont
separees par les separateurs qui sont :
l'espace et les caracteres # : ; = ainsi que deux apostrophes
consecutives '', ou une chaine encadree de (), [], {}, <>
--> Le type de la donnee EFFECTIVEMENT lue est IRE :
IRE=1, ENTIER ,au plus 9 chiffres significatifs ;
IRE=2, REEL ,au plus 16 chiffres significatifs (Double precision);
ou expression mathematique (encadre de $)
IRE=3, MOT ,au plus 80 caracteres sans separateurs ;
IRE=4, TEXTE ,au plus 78 caracteres encadres d'apostrophes .
> Le nombre de caracteres d'un MOT ou d'un TEXTE lu est NCAR .
--> Un REEL est une donnee de l'une des formes suivantes :
xx.yy xx.yyEzz xx.yyDzz
xx , yy , zz etant des entiers (xx et zz etant signes ou non)
ou le resultat d'expression encadree de $.
(Le point decimal peut etre remplace par une virgule)
--> Un MOT commence obligatoirement par l'une des 26 lettres de l'alphabet
(majuscule ou minuscule), les autres caracteres peuvent etre quelconques
(separateurs exceptes).
--> Un TEXTE est encadre par 2 apostrophes: ' et il peut y avoir des blancs
ou des separateurs a l''interieur ! '.
--> Les LIGNES DE DONNEES commencant par !, $, * ou // sont des
'LIGNES' commentaires , elles sont ignorees ( si NOCO = 0 ).
Les articles suivant un ! % @ ou // sont ignores jusqu'a la fin
de la ligne les contenant
Les articles encadres de (), < >, [] ou {} sont consideres comme
des separateurs et sont ignores
-- Quelques Definitions :
- NUM numero de la carte de donnees
- NRAN numero de colonne dans la ligne de donnees
- LEC numero d'unite logique de lecture de donnees
- IMP numero d'unite du fichier d'impression des donnees en echo
- IECR indice d'impression sur l'unit IMP
- KNUM : ?
- IRWD indice de rembobinage du fichier de lecture
- NOCO indice permettant d'ignorer ou non les cartes commentaires
- IRET indice de retour en cas d'erreur en lecture (=1) ou non (=0)
- NAVANT type de la derniere donnee que l'on a cherche a lire
- TEXT MOT (IRE = 3) ou TEXTE (IRE = 4) lu
- FLOT REEL lu (IRE = 2 ) ou ENTIER lu (IRE = 1) converti en D.P.
- NFIX ENTIER lu (IRE = 1)
- IRE type de la donnee lue
- NER numero d'erreur en cas d'erreur detectee
- NCAR nombre de caracteres ASCII de la donnee lue
- ILU ?
- IOP tableau d'indices affecte au(x) type(s) de donnee a lire
-- Procedures utilisees
CHARTY recherche du type de lecture d'un caractere (Utiliter)
=0 separateur (blanc ou # : ; =) =1 ! ou % ou @
=2 ( ou < ou [ ou { =3 ) ou > ou ] ou }
=4 ' ou " ou ` =5 + ou -
=6 . ou , =7 lettre
=8 chiffre =9 $ (dollar)
=10 \ (antislash) =11 / (slash)
=12 autre caractere
REDNBR reconnaissance d'un nombre
REDMAT reconnaissance d'une expression mathematique
INTEGER N
INTEGER KTRVIN,NFIX,IRE,NER,NCAR,ILU,IOP
& ,NUM,NRAN,LEC,IMP,IECR,KNUM,IRWD,NOCO,IRET,NAVANT
& ,IMPPAL,IMPSDR,IMPMES,NBMESG,LUAPOS
& ,NBR,NBRRR,IRETU,NDEB,IDEB,ITCHAR
& ,KDEB,IFIN,NLU,I,IK,COMMLU,SLASLU,N1,N2
LOGICAL EXCLLU,LITERA
PARAMETER (KTRVIN = 80)
CHARACTER CHCOUR,CARTE,TEXTEC(KTRVIN)
CHARACTER TEXTE*80,CARTEC*80,TEXT*4,PRFXAF*8
DOUBLE PRECISION FLOT
COMMON/REDCO1/ FLOT,NFIX,IRE,NER,NCAR,ILU,IOP(5)
COMMON/REDCOM/ TEXT(20)
COMMON/REDCA1/ NUM,NRAN,LEC,IMP,IECR,KNUM,IRWD,NOCO,IRET,NAVANT
COMMON/REDCAR/ CARTE(KTRVIN)
COMMON/FICHIM/ IMPPAL,IMPSDR,IMPMES,NBMESG
EQUIVALENCE (TEXTE,TEXT,TEXTEC)
DATA IRETU/0/
COMMLU=0
SLASLU=0
EXCLLU=.FALSE.
IF (N.LT.0) THEN
NRAN=KTRVIN
IF (KNUM.EQ.1) GOTO 90001
NER=0
KNUM=1
NCAR=0
GOTO 90001
ENDIF
IF (N.GT.0) THEN
NBR=N
IF (N.NE.NAVANT) THEN
NAVANT=N
DO 1 I=1,5
NBRRR=NBR/2
IOP(I)=NBR-NBRRR*2
NBR=NBRRR
1 CONTINUE
ENDIF
IF (KNUM.NE.0) GOTO 10
ENDIF
IF (KNUM.EQ.0) THEN
KNUM=1
IRET=IRETU
NER=0
NCAR=0
ENDIF
-- Lecture de la 'carte' suivante :
2 IF (COMMLU.GT.0) WRITE (IMPPAL,1008) NUM,CARTE
&,(' ',I=1,COMMLU-1),'!',(' ',I=COMMLU+1,80),CARTE(COMMLU),COMMLU
READ (LEC,1000,END=106) CARTE
CARTEC=' '
EXCLLU=.FALSE.
COMMLU=0
SLASLU=0
NRAN=0
NUM=NUM+1
IF (IECR.EQ.1) WRITE (IMP,1001) CARTE,PRFXAF ( ),NUM,LEC
IF (N.EQ.0) THEN
-- On a lu un TITRE
NRAN=KTRVIN
Les blancs de debut et de fin du titre sont elimines :
DO 3 NCAR=NRAN,1,-1
IF (CARTE(NCAR).NE.' ') GOTO 4
3 CONTINUE
4 DO 5 NDEB=1,NCAR
IF (CARTE(NDEB).NE.' ') GOTO 6
5 CONTINUE
6 DO 7 I=NDEB,NCAR
TEXTEC(I-NDEB+1)=CARTE(I)
7 CONTINUE
NCAR=NCAR+1-NDEB
GOTO 90001
ENDIF
La 'carte' est-elle une carte commentaire?
Si oui, passage a la suivante
IF (NOCO.NE.1.AND.(CARTE(1).EQ.'*'.OR.CARTE(1).EQ.'$')) GOTO 2
-- On a lu le premier caractere d'un article autre qu'un titre
Recherche du premier caractere non separateur de l'article suivant , i.e.
Premier caractere de l'ENTIER ( un chiffre ou + ou - )
Premier caractere du REEL ( un chiffre ou + ou - ou . )
Premier caractere du MOT ( une lettre )
Premier caractere du TEXTE ( un ' ou un " )
On ignore les articles suivant un ! ou entre ( ) ou entre < > .
10 NRAN=NRAN+1
IF (NRAN.GT.KTRVIN) GOTO 2
CHCOUR=CARTE(NRAN)
NLU=1
CALL CHARTY(CHCOUR,NLU,ITCHAR) !utilite
IF (COMMLU.GT.0) THEN
Fin de commentaire ) > ] }
IF (ITCHAR.EQ.3) COMMLU=0
GOTO 10
ELSEIF (SLASLU.GT.0) THEN
Commentaire //
IF (ITCHAR.EQ.11) THEN
GOTO 2
ELSE
SLASLU=-1
NRAN=NRAN-1
GOTO 33333
ENDIF
ELSE
IF (ITCHAR.EQ.7) THEN
On a lu un caractere alphabetique
GOTO 44444
ELSEIF (ITCHAR.EQ.0.OR.ITCHAR.EQ.3) THEN
On a lu un caractere separateur
GOTO 10
ELSEIF (ITCHAR.EQ.1) THEN
On a lu un indicateur de commentaire ! % @
GOTO 2
ELSEIF (ITCHAR.EQ.2) THEN
On a lu une parenthese ouvrante ( < [ {
COMMLU=NRAN
GOTO 10
ELSEIF (ITCHAR.EQ.4) THEN
On a lu un apostrophe ' " `
GOTO 88888
ELSEIF (ITCHAR.EQ.5.OR.ITCHAR.EQ.6.OR.ITCHAR.EQ.8) THEN
On a lu un signe + - . ,
GOTO 11111
ELSEIF (ITCHAR.EQ.9) THEN
On a lu le caractere $
GOTO 99990
ELSEIF (ITCHAR.EQ.11) THEN
On a lu le caractere /
SLASLU=NRAN
IF (NRAN.LT.KTRVIN) GOTO 10
SLASLU=-1
GOTO 33333
ENDIF
CARTEC(NRAN:NRAN)='!'
WRITE (IMP,1002) NUM,CARTE,CARTEC,CHCOUR,NRAN
ENDIF
GOTO 10
-- On a lu un Nombre ENTIER ou REEL
11111 IF ((IOP(1)+IOP(2)).LE.0) GOTO 108
IF (IOP(5).EQ.1) THEN
IRE=1
GOTO 90001
ENDIF
LITERA=.FALSE.
CALL REDNBR (CARTE,NRAN,KTRVIN,LITERA,EXCLLU,IRE,NFIX,FLOT)
IF (IRE.EQ.2) THEN
IF (IOP(2).NE.1) GOTO 109
ELSEIF (IRE.NE.1) THEN
GOTO 107
ENDIF
GOTO 90001
-- On a lu une expression encadree de $
99990 IF (IOP(1)+IOP(2).LE.0) GOTO 108
NCAR=0
IDEB=NRAN+1
99991 NRAN=NRAN+1
IF (NRAN.GT.KTRVIN) GOTO 105
NLU=1
CHCOUR=CARTE(NRAN)
IF (CHCOUR.EQ.' ') GOTO 99991
CALL CHARTY (CHCOUR,NLU,ITCHAR) !utilite
IF (ITCHAR.NE.9) THEN
NCAR=NCAR+1
TEXTEC(NCAR)=CHCOUR
GOTO 99991
ENDIF
IF (NCAR.LE.0) GOTO 105
CALL REDMAT (TEXTE(1:NCAR),TEXTEC,NER,N1,N2,FLOT)
IF (NER.NE.0) GOTO 120
IRE=2
IF (IOP(2).NE.1) GOTO 109
GOTO 90001
-- On a lu le caractere '/' (liste d'entiers consecutifs)
33333 TEXT(1)='/'
IRE=3
GOTO 90001
-- On a lu un MOT
44444 IF (IOP(3).NE.1) GOTO 103
TEXT(1)=' '
TEXT(2)=' '
IDEB=NRAN-1
LUAPOS=0
44445 CARTE(NRAN)=CHCOUR
NRAN =NRAN+1
IF (NRAN.GT.KTRVIN) GOTO 44446
CHCOUR=CARTE(NRAN)
NLU = 1
CALL CHARTY (CHCOUR,NLU,ITCHAR) !utilite
IF (ITCHAR.EQ.0) THEN
GOTO 44446
ELSEIF (ITCHAR.EQ.1) THEN
EXCLLU=.TRUE.
GOTO 44446
ELSEIF (ITCHAR.NE.4) THEN
GOTO 44445
ENDIF
LUAPOS=1
44446 IFIN=NRAN-1
NCAR=IFIN-IDEB
DO 44447 I=1,NCAR
TEXTEC(I)=CARTE(IDEB+I)
44447 CONTINUE
NRAN=NRAN-LUAPOS
IRE=3
GOTO 90001
-- On a lu un TEXTE
88888 IRE=4
IF (IOP(4).NE.1) GOTO 104
KDEB=1
IDEB=NRAN+1
88889 NRAN=NRAN+1
IF (NRAN.GT.KTRVIN) GOTO 1051
NLU=0
CALL CHARTY (CARTE(NRAN),NLU,ITCHAR) !utilite
IF (ITCHAR.NE.4) GOTO 88889
IFIN=NRAN-1
NCAR=IFIN-IDEB+1
IK=IDEB+KDEB-1
IF (NCAR.LE.0) GOTO 10
DO 88890 I=0,NCAR-1
TEXTEC(KDEB+I)=CARTE(IK+I)
88890 CONTINUE
NRAN=NRAN+1
IF (NRAN.GT.KTRVIN) GOTO 90001
NLU = 0
CALL CHARTY (CARTE(NRAN),NLU,ITCHAR) !utilite
IF (ITCHAR.EQ.0.OR.ITCHAR.EQ.1) THEN
GOTO 90001
ELSEIF (ITCHAR.EQ.4) THEN
GOTO 105
ENDIF
88891 KDEB=NCAR+1
IDEB=IDEB+1
GOTO 88889
-- Messages d'erreur
103 NER=3
CARTEC(NRAN:NRAN)='!'
WRITE (IMPPAL,1003) NUM,CARTE,CARTEC,'MOT',NRAN,'autre chose'
GOTO 90000
104 NER=4
CARTEC(NRAN:NRAN)='!'
WRITE (IMPPAL,1003) NUM,CARTE,CARTEC,'TEXTE',NRAN,'autre chose'
GOTO 90000
105 NER=5
CARTEC(IDEB:IDEB)='!'
WRITE (IMPPAL,1005) NUM,CARTE,CARTEC,IDEB
GOTO 90000
1051 NER=5
CARTEC(IDEB:IDEB)='!'
CARTEC(KTRVIN:KTRVIN)='$'
WRITE (IMPPAL,1005) NUM,CARTE,CARTEC,IDEB
WRITE (IMPPAL,1015) KTRVIN
GOTO 90000
-
106 IF (IRWD.EQ.1) THEN
NER=6
IRWD=0
REWIND (LEC)
KNUM=0
GOTO 90001
ENDIF
NER=6
WRITE (IMPPAL,1006) PRFXAF ( ),LEC,NUM
GOTO 90000
107 NER=7
CARTEC(NRAN:NRAN)='!'
WRITE (IMPPAL,1007) NUM,CARTE,CARTEC,NRAN
GOTO 90000
108 NER=8
CARTEC(NRAN:NRAN)='!'
WRITE (IMPPAL,1003) NUM,CARTE,CARTEC,'NOMBRE',NRAN,'autre chose'
GOTO 90000
109 NER=9
CARTEC(NRAN:NRAN)='!'
WRITE (IMPPAL,1003) NUM,CARTE,CARTEC,'FLOTTANT',NRAN,'un ENTIER'
GOTO 90000
120 IF (NER.EQ.1) THEN
WRITE (IMPPAL,1021) NUM,CARTE,TEXTE(N1:N2),TEXTE(1:NCAR)
ELSEIF (NER.EQ.2) THEN
WRITE (IMPPAL,1022) NUM,CARTE,TEXTE(N1:N2)
ELSEIF (NER.EQ.3) THEN
WRITE (IMPPAL,1023) NUM,CARTE,TEXTE(N1:N2),TEXTE(1:NCAR)
ELSEIF (NER.EQ.4) THEN
WRITE (IMPPAL,1024) NUM,CARTE,TEXTE(1:NCAR)
ELSEIF (NER.EQ.5) THEN
WRITE (IMPPAL,1025) NUM,CARTE,TEXTE(N1:N2),TEXTE(1:NCAR)
ENDIF
NER=7
--
90000 IF (IRET.NE.1) CALL BAISE (' STOP --> Redlec') !utilite
90001 IF (EXCLLU) THEN
CARTEC(NRAN:NRAN)='!'
IF (IECR.EQ.1) WRITE (IMP,1001) CARTEC,'Comment.',NUM,LEC
NRAN=KTRVIN
ENDIF
RETURN
1000 FORMAT (80A1)
1001 FORMAT ('>',80A1,'<',A8,' Ligne #',I3,' sur Unite ',I2)
1002 FORMAT (T2,I5,' <',80A1,'>'/,T9,A80/,T9,'Signe indesirable ('
&,A1,') au',I3,'-eme caractere : Celui-ci est ignore.')
1003 FORMAT (T2,I5,' <',80A1,'>'/,T9,A80/,T9,'On a lu un ',A,' au',I3
&,'-eme Caractere alors qu''on voulait ',A,'.')
1005 FORMAT (T2,I5,' <',80A1,'>'/,T9,A80/
&,T9,'TEXTE incorrect - Analyse arretee au ',I2,'-eme caractere'
&,' du texte.')
1015 FORMAT (T9,'Il manque l''apostrophe fermante ou bien la chaine'
&,' excede la',I3,'-eme colonne.')
1006 FORMAT (T2,A8,' On cherche a lire quelque chose alors que les '
&,'donnees sont epuisees sur l''unite ',I3,'. Nombre de lignes :'
&,I5)
1007 FORMAT (T2,I5,' <',80A1,'>'/,T9,A80
&,T2,'NOMBRE incorrect - Analyse arretee au ',I2,'-eme caractere.'
&,' du nombre.')
1008 FORMAT (T2,I5,' <',80A1,'>',/,T9,80A1,/,' caractere ',A1
&,' non ferme en',I3,'-eme position;'
&,' le reste de la ligne est ignore.')
1021 FORMAT (T2,I5,' <',80A1,'>'/
&,T9,'Nombre invalide ',A,' dans l''expression : $',A,'$.')
1022 FORMAT (T2,I5,' <',80A1,'>'/
&,T9,'Expression mathematique non reconnue : $',A,'$.')
1023 FORMAT (T2,I5,' <',80A1,'>'/
&,T9,'Operande invalide ',A,' dans l''expression : $',A,'$.')
1024 FORMAT (T2,I5,' <',80A1,'>'/
&,T9,'Operation non definie dans l''expression : $',A,'$.')
1025 FORMAT (T2,I5,' <',80A1,'>'/
&,T9,'Argument de la fonction invalide pour ',A
&,' dans l''expression : $',A,'$.')
END !Redlec
redlec est appelé dans (15 procédures)