Télécharger redlec.eso

Retour à la liste

Numérotation des lignes :

  1. C REDLEC SOURCE JC220346 18/12/04 21:16:08 9991
  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. -INC CCNOYAU
  25. * SAVE SEPARA,EPSI,CARAC
  26. * LOGICAL SEPARA
  27. CHARACTER*25 CARAC
  28. CHARACTER*117 CAROK
  29. REAL*8 DP
  30. C 1111111111222
  31. C 1 234567890123456789012
  32. DATA CARAC /' ''+-/*=.0123456789DEQdeq%'/
  33. DATA CAROK/'1234567890°+&é(-è_çà)=~#{[|`\\^@]}¤?azertyuiop^$qsdfgh
  34. >jklmù*wxcvbn,;:!AZERTYUIOPQSDFGHJKLM%µWXCVBN?.§<>äëÿüïöâêûîô£''/'/
  35. C
  36. * ith=0
  37. * call ooonth(ith)
  38. * write (6,*) ' thread ',ith, 'redlec pointeur ',sredle
  39. MOT(1:LONOM)=' '
  40. 5 NRAN=NRAN+1
  41. IF (NRAN.GT.ICOUR) GOTO 2
  42. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  43. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  44. INDIN=23
  45. IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  46. * SI SEPARA EST VRAI ON CONSIDERE + ET - ET . COMME DES MOTS
  47. IF (SEPARA.AND.(IND.EQ.3.OR.IND.EQ.4.OR.IND.EQ.8)) THEN
  48. INDIN=IND
  49. GOTO 60
  50. ENDIF
  51. SEPARA=.FALSE.
  52. IF (IND.EQ.0) GOTO 60
  53. IF (IND.EQ.1) GOTO 5
  54. INDIN=IND
  55. IF(IND.EQ.2) GOTO 60
  56. IF(IND.GT.18) GOTO 60
  57. IF (IND.GE.5.AND.IND.LE.7) GOTO 60
  58. C
  59. C ON A LU UN NOMBRE
  60. C
  61. IRE=1
  62. IDE=NRAN
  63. NFIX=0
  64. ISGN=0
  65. IDEC=-1
  66. IEXP=0
  67. KSGN=1
  68. IF (IND.EQ.4) KSGN=-1
  69. IF (IND.NE.3.AND.IND.NE.4) GOTO 25
  70. 22 NRAN=NRAN+1
  71. IF(NRAN.GT.ICOUR) GOTO 30
  72. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  73. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  74. IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  75. IF (IND.NE.0) GOTO 25
  76. 24 CONTINUE
  77. NRAN=IDE
  78. IND=INDIN
  79. GOTO 60
  80. 25 IF(IND.LT.9.OR.IND.GT.18) GOTO 28
  81. ISGN=ISGN+1
  82. IF(IDEC.GE.0) IDEC=IDEC+1
  83. IF(ISGN-10) 26,252,255
  84. 252 MFIX=NFIX
  85. NFIX=0
  86. GOTO 26
  87. 255 IF(ISGN.LT.19) GOTO 26
  88. IF(IDEC.LT.0) IEXP=IEXP+1
  89. IF(IDEC.GE.0) IDEC=IDEC-1
  90. GOTO 22
  91. 26 NFIX=10*NFIX+IND-9
  92. GOTO 22
  93. 28 IF(IND.EQ.1) GOTO 30
  94. IF (IND.EQ.8) GOTO 29
  95. IF(IND.LE.7.AND.IND.GE.3) GOTO 300
  96. IF(IND.GT.18) GOTO 40
  97. GOTO 24
  98. 29 IF (IDEC.GE.0) GOTO 24
  99. IDEC=0
  100. GOTO 22
  101. 300 IF (IDEC.LT.0) NRAN=NRAN-1
  102. SEPARA=.TRUE.
  103. 30 IF (ISGN.EQ.0) GOTO 24
  104. IF (IDEC.GE.0) GOTO 40
  105. C
  106. C ON A LU UN ENTIER
  107. C
  108. NCAR=NRAN-IDE
  109. IRE=1
  110. IF(ISGN.GT.9) GOTO 40
  111. IF(KSGN.LT.0) NFIX=-NFIX
  112. FLOT=NFIX
  113. RETURN
  114. C
  115. C ON A LU UN FLOTTANT
  116. C
  117. 40 IRE=2
  118. FLOT=NFIX
  119. IF(ISGN.LT.10) GOTO 41
  120. DP=MFIX
  121. IF(ISGN.GT.18) ISGN=18
  122. FLOT=FLOT+DP*1D1**(ISGN-9)
  123. 41 IF(IDEC.LT.0) IDEC=0
  124. IEXP=IEXP-IDEC
  125. IF(IND.EQ.1) GOTO 55
  126. IF (IND.LE.7.AND.IND.GE.3) GOTO 550
  127. ISGN=1
  128. NFIX=0
  129. NRAN=NRAN+1
  130. IF (NRAN.GT.ICOUR) GOTO 53
  131. IND=INDEX(CARAC(3:4),TEXT(NRAN:NRAN))+2
  132. IF (IND.EQ.2) GOTO 305
  133. IF (IND.EQ.4) ISGN=-1
  134. 42 NRAN=NRAN+1
  135. IF(NRAN.GT.ICOUR) GOTO 53
  136. 305 CONTINUE
  137. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  138. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  139. IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  140. IF (IND.EQ.0) GOTO 24
  141. IF(IND.EQ.1) GOTO 52
  142. IF (IND.LE.7.AND.IND.GE.3) GOTO 520
  143. IF(IND.LT.9.OR.IND.GT.18) GOTO 24
  144. NFIX=10*NFIX+IND-9
  145. GOTO 42
  146. 52 NRAN1=NRAN-1
  147. IF (INDEX(CARAC(19:24),TEXT(NRAN1:NRAN1)).NE.0) GOTO 42
  148. GOTO 521
  149. 520 NRAN=NRAN-1
  150. SEPARA=.TRUE.
  151. 521 CONTINUE
  152. 53 IF(ISGN.LT.0) NFIX=-NFIX
  153. IEXP=IEXP+NFIX
  154. GOTO 55
  155. 550 NRAN=NRAN-1
  156. SEPARA=.TRUE.
  157. 55 FLOT=FLOT*1D1**IEXP
  158. IF(KSGN.LT.0) FLOT=-FLOT
  159. NCAR=NRAN-IDE
  160. RETURN
  161. C
  162. C ON A LU UN MOT OU UN TEXT
  163. C
  164. 60 MOT=' '
  165. IF (IND.EQ.2) GOTO 70
  166. C
  167. C ON A LU UN MOT
  168. C
  169. IRE=3
  170. IDEB=NRAN
  171. IF ((INDIN.LT.3.OR.INDIN.GT.8).AND.INDIN.NE.25) GOTO 66
  172. NRAN=NRAN+1
  173. IF (INDIN.NE.6) GOTO 68
  174. IF (NRAN.GT.ICOUR) GOTO 68
  175. IF (TEXT(NRAN:NRAN).NE.CARAC(6:6)) GOTO 68
  176. NRAN=NRAN+1
  177. GOTO 68
  178. 66 NRAN=NRAN+1
  179. IF(NRAN.GT.ICOUR) GOTO 68
  180. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  181. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  182. INDAUX=INDEX(CARAC,TEXT(NRAN:NRAN))
  183. IF (INDAUX.EQ.1.OR.INDAUX.EQ.2) GOTO 68
  184. IF ((INDAUX.LT.3.OR.INDAUX.GT.8).AND.INDAUX.NE.25) GOTO 66
  185. SEPARA=.TRUE.
  186. IFIN=NRAN-1
  187. GO TO 680
  188. 68 IFIN=NRAN-1
  189. SEPARA=.FALSE.
  190. 680 CONTINUE
  191. NCAR=IFIN-IDEB+1
  192. NCAR=MIN(72,NCAR)
  193. MOT(1:NCAR)=TEXT(IDEB:IFIN)
  194. NRAN=NRAN-1
  195. IF(MOT(1:1).EQ.'.') IRE=6
  196. IF(MOT(1:1).EQ.'%') IRE=7
  197. C
  198. C CE MOT EST-IL 'VRAI' OU 'FAUX' AUQUEL CAS ON A LU UN LOGIQUE
  199. C
  200. IF (MOT(1:5).EQ.'VRAI ') THEN
  201. BOOL=.TRUE.
  202. IRE=5
  203. ELSEIF (MOT(1:5).EQ.'FAUX ') THEN
  204. BOOL=.FALSE.
  205. IRE=5
  206. ENDIF
  207. RETURN
  208. 70 IRE=4
  209. NRAN=NRAN+1
  210. IDEB=NRAN
  211. icar=1
  212. jcar=ideb
  213. 71 NRAN=NRAN+1
  214. IF (NRAN.GT.ICOUR) GOTO 72
  215. IF (TEXT(NRAN:NRAN).EQ.CARAC(2:2)) then
  216. if (nran+1.gt.icour) goto 72
  217. if (text(nran+1:nran+1).ne.carac(2:2)) goto 72
  218. * double quote ==> une seule dans le texte rendu
  219. nran=nran+1
  220. ifin=nran-1
  221. ncar=icar+ifin-jcar
  222. mot(icar:ncar)=text(jcar:ifin)
  223. icar=ncar+1
  224. jcar=ifin+2
  225. goto 71
  226. endif
  227. GOTO 71
  228. 72 IFIN=NRAN-1
  229. NCAR=IFIN-IDEB+1
  230. NCAR=MIN(72,NCAR)
  231. MOT(icar:NCAR)=TEXT(jcar:IFIN)
  232. RETURN
  233. 2 IRE=0
  234. RETURN
  235. END
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales