1 : C REDLEC SOURCE PV 13/07/05 21:15:12 7792 2 : C LECTURE DE DONNEES EN FORMAT LIBRE 3 : C 4 : SUBROUTINE REDLEC(SREDLE) 5 : C 6 : C LECTURE DE DONNEES EN FORMAT LIBRE 7 : C LES RESULTATS SONT DANS LE COMMON /COPTIO/ 8 : C LE TYPE DE LA DONNEE EFFECTIVEMENT LUE EST IRE 9 : C IRE=1 : ENTIER IRE=2 : FLOTTANT IRE=3 : MOT IRE=4 : TEXTE 10 : C IRE=5 : LOGIQUE IRE=0 : FIN DE DIRECTIVE 11 : C 12 : C - ENTIER NFIX AU PLUS NEUF CHIFFRES SIGNIFICATIFS 13 : C - FLOTTANT AU PLUS SEIZE CHIFFRES SIGNIFICATIFS 14 : C - MOT OU TEXTE AU PLUS SOIXANTE-DOUZE CARACTERES 15 : C - LE NOMBRE DE CARACTERE DU MOT OU DU TEXTE EST NCAR 16 : C - LES SEPARATEURS (QUI SONT TRANSMIS COMME DES MOTS) SONT : 17 : C ' ','=','+','-','*','/','%' 18 : C LE POINT '.' DANS UN MOT EST PRIS COMME SEPARATEUR IL EST MEME 19 : C RENVOYE COMMME TYPE SEPARATEUR IRE = 6 20 : C 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : -INC CCREDLE 24 : * SAVE SEPARA,EPSI,CARAC 25 : * LOGICAL SEPARA 26 : CHARACTER*25 CARAC 27 : CHARACTER*117 CAROK 28 : REAL*8 DP 29 : C 1111111111222 30 : C 1 234567890123456789012 31 : DATA CARAC /' ''+-/*=.0123456789DEQdeq%'/ 32 : DATA CAROK/'1234567890°+&é(-è_çà)=~#{[|`\\^@]}¤?azertyuiop^$qsdfgh 33 : >jklmù*wxcvbn,;:!AZERTYUIOPQSDFGHJKLM%µWXCVBN?.§<>äëÿüïöâêûîô£''/'/ 34 : C 35 : ith=0 35 : call ooonth(ith) 36 : * write (6,*) ' thread ',ith, 'redlec pointeur ',sredle 37 : MOT(1:8)=' ' 38 : 5 NRAN=NRAN+1 39 : IF (NRAN.GT.ICOUR) GOTO 2 40 : INDC=INDEX(CAROK,TEXT(NRAN:NRAN)) 41 : IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' ' 42 : INDIN=23 43 : IND=INDEX(CARAC,TEXT(NRAN:NRAN)) 44 : * SI SEPARA EST VRAI ON CONSIDERE + ET - ET . COMME DES MOTS 45 : IF (SEPARA.AND.(IND.EQ.3.OR.IND.EQ.4.OR.IND.EQ.8)) THEN 46 : INDIN=IND 47 : GOTO 60 48 : ENDIF 49 : SEPARA=.FALSE. 50 : IF (IND.EQ.0) GOTO 60 51 : IF (IND.EQ.1) GOTO 5 52 : INDIN=IND 53 : IF(IND.EQ.2) GOTO 60 54 : IF(IND.GT.18) GOTO 60 55 : IF (IND.GE.5.AND.IND.LE.7) GOTO 60 56 : C 57 : C ON A LU UN NOMBRE 58 : C 59 : IRE=1 60 : IDE=NRAN 61 : NFIX=0 62 : ISGN=0 63 : IDEC=-1 64 : IEXP=0 65 : KSGN=1 66 : IF (IND.EQ.4) KSGN=-1 67 : IF (IND.NE.3.AND.IND.NE.4) GOTO 25 68 : 22 NRAN=NRAN+1 69 : IF(NRAN.GT.ICOUR) GOTO 30 70 : INDC=INDEX(CAROK,TEXT(NRAN:NRAN)) 71 : IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' ' 72 : IND=INDEX(CARAC,TEXT(NRAN:NRAN)) 73 : IF (IND.NE.0) GOTO 25 74 : 24 CONTINUE 75 : NRAN=IDE 76 : IND=INDIN 77 : GOTO 60 78 : 25 IF(IND.LT.9.OR.IND.GT.18) GOTO 28 79 : ISGN=ISGN+1 80 : IF(IDEC.GE.0) IDEC=IDEC+1 81 : IF(ISGN-10) 26,252,255 82 : 252 MFIX=NFIX 83 : NFIX=0 84 : GOTO 26 85 : 255 IF(ISGN.LT.19) GOTO 26 86 : IF(IDEC.LT.0) IEXP=IEXP+1 87 : IF(IDEC.GE.0) IDEC=IDEC-1 88 : GOTO 22 89 : 26 NFIX=10*NFIX+IND-9 90 : GOTO 22 91 : 28 IF(IND.EQ.1) GOTO 30 92 : IF (IND.EQ.8) GOTO 29 93 : IF(IND.LE.7.AND.IND.GE.3) GOTO 300 94 : IF(IND.GT.18) GOTO 40 95 : GOTO 24 96 : 29 IF (IDEC.GE.0) GOTO 24 97 : IDEC=0 98 : GOTO 22 99 : 300 IF (IDEC.LT.0) NRAN=NRAN-1 100 : SEPARA=.TRUE. 101 : 30 IF (ISGN.EQ.0) GOTO 24 102 : IF (IDEC.GE.0) GOTO 40 103 : C 104 : C ON A LU UN ENTIER 105 : C 106 : NCAR=NRAN-IDE 107 : IRE=1 108 : IF(ISGN.GT.9) GOTO 40 109 : IF(KSGN.LT.0) NFIX=-NFIX 110 : FLOT=NFIX 111 : RETURN 112 : C 113 : C ON A LU UN FLOTTANT 114 : C 115 : 40 IRE=2 116 : FLOT=NFIX 117 : IF(ISGN.LT.10) GOTO 41 118 : DP=MFIX 119 : IF(ISGN.GT.18) ISGN=18 120 : FLOT=FLOT+DP*1D1**(ISGN-9) 121 : 41 IF(IDEC.LT.0) IDEC=0 122 : IEXP=IEXP-IDEC 123 : IF(IND.EQ.1) GOTO 55 124 : IF (IND.LE.7.AND.IND.GE.3) GOTO 550 125 : ISGN=1 126 : NFIX=0 127 : NRAN=NRAN+1 128 : IF (NRAN.GT.ICOUR) GOTO 53 129 : IND=INDEX(CARAC(3:4),TEXT(NRAN:NRAN))+2 130 : IF (IND.EQ.2) GOTO 305 131 : IF (IND.EQ.4) ISGN=-1 132 : 42 NRAN=NRAN+1 133 : IF(NRAN.GT.ICOUR) GOTO 53 134 : 305 CONTINUE 135 : INDC=INDEX(CAROK,TEXT(NRAN:NRAN)) 136 : IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' ' 137 : IND=INDEX(CARAC,TEXT(NRAN:NRAN)) 138 : IF (IND.EQ.0) GOTO 24 139 : IF(IND.EQ.1) GOTO 52 140 : IF (IND.LE.7.AND.IND.GE.3) GOTO 520 141 : IF(IND.LT.9.OR.IND.GT.18) GOTO 24 142 : NFIX=10*NFIX+IND-9 143 : GOTO 42 144 : 52 NRAN1=NRAN-1 145 : IF (INDEX(CARAC(19:24),TEXT(NRAN1:NRAN1)).NE.0) GOTO 42 146 : GOTO 521 147 : 520 NRAN=NRAN-1 148 : SEPARA=.TRUE. 149 : 521 CONTINUE 150 : 53 IF(ISGN.LT.0) NFIX=-NFIX 151 : IEXP=IEXP+NFIX 152 : GOTO 55 153 : 550 NRAN=NRAN-1 154 : SEPARA=.TRUE. 155 : 55 FLOT=FLOT*1D1**IEXP 156 : IF(KSGN.LT.0) FLOT=-FLOT 157 : NCAR=NRAN-IDE 158 : RETURN 159 : C 160 : C ON A LU UN MOT OU UN TEXT 161 : C 162 : 60 MOT=' ' 163 : IF (IND.EQ.2) GOTO 70 164 : C 165 : C ON A LU UN MOT 166 : C 167 : IRE=3 168 : IDEB=NRAN 169 : IF ((INDIN.LT.3.OR.INDIN.GT.8).AND.INDIN.NE.25) GOTO 66 170 : NRAN=NRAN+1 171 : IF (INDIN.NE.6) GOTO 68 172 : IF (NRAN.GT.ICOUR) GOTO 68 173 : IF (TEXT(NRAN:NRAN).NE.CARAC(6:6)) GOTO 68 174 : NRAN=NRAN+1 175 : GOTO 68 176 : 66 NRAN=NRAN+1 177 : IF(NRAN.GT.ICOUR) GOTO 68 178 : INDC=INDEX(CAROK,TEXT(NRAN:NRAN)) 179 : IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' ' 180 : INDAUX=INDEX(CARAC,TEXT(NRAN:NRAN)) 181 : IF (INDAUX.EQ.1.OR.INDAUX.EQ.2) GOTO 68 182 : IF ((INDAUX.LT.3.OR.INDAUX.GT.8).AND.INDAUX.NE.25) GOTO 66 183 : SEPARA=.TRUE. 184 : IFIN=NRAN-1 185 : GO TO 680 186 : 68 IFIN=NRAN-1 187 : SEPARA=.FALSE. 188 : 680 CONTINUE 189 : NCAR=IFIN-IDEB+1 190 : NCAR=MIN(72,NCAR) 191 : MOT(1:NCAR)=TEXT(IDEB:IFIN) 192 : NRAN=NRAN-1 193 : IF(MOT(1:1).EQ.'.') IRE=6 194 : IF(MOT(1:1).EQ.'%') IRE=7 195 : C 196 : C CE MOT EST-IL 'VRAI' OU 'FAUX' AUQUEL CAS ON A LU UN LOGIQUE 197 : C 198 : IF (MOT(1:5).EQ.'VRAI') THEN 199 : BOOL=.TRUE. 200 : IRE=5 201 : ELSEIF (MOT(1:5).EQ.'FAUX') THEN 202 : BOOL=.FALSE. 203 : IRE=5 204 : ENDIF 205 : RETURN 206 : 70 IRE=4 207 : NRAN=NRAN+1 208 : IDEB=NRAN 209 : 71 NRAN=NRAN+1 210 : IF (NRAN.GT.ICOUR) GOTO 72 211 : IF (TEXT(NRAN:NRAN).EQ.CARAC(2:2)) GOTO 72 212 : GOTO 71 213 : 72 IFIN=NRAN-1 214 : NCAR=IFIN-IDEB+1 215 : NCAR=MIN(72,NCAR) 216 : MOT(1:NCAR)=TEXT(IDEB:IFIN) 217 : RETURN 218 : 2 IRE=0 219 : RETURN 220 : END 221 : 222 : 223 : 224 : 225 : 226 : 227 : 228 : 229 : 230 :
© Cast3M 2003 - All rights reserved.
Disclaimer