Télécharger redlec.eso

Retour à la liste

Numérotation des lignes :

  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
  36. call ooonth(ith)
  37. * write (6,*) ' thread ',ith, 'redlec pointeur ',sredle
  38. MOT(1:8)=' '
  39. 5 NRAN=NRAN+1
  40. IF (NRAN.GT.ICOUR) GOTO 2
  41. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  42. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  43. INDIN=23
  44. IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  45. * SI SEPARA EST VRAI ON CONSIDERE + ET - ET . COMME DES MOTS
  46. IF (SEPARA.AND.(IND.EQ.3.OR.IND.EQ.4.OR.IND.EQ.8)) THEN
  47. INDIN=IND
  48. GOTO 60
  49. ENDIF
  50. SEPARA=.FALSE.
  51. IF (IND.EQ.0) GOTO 60
  52. IF (IND.EQ.1) GOTO 5
  53. INDIN=IND
  54. IF(IND.EQ.2) GOTO 60
  55. IF(IND.GT.18) GOTO 60
  56. IF (IND.GE.5.AND.IND.LE.7) GOTO 60
  57. C
  58. C ON A LU UN NOMBRE
  59. C
  60. IRE=1
  61. IDE=NRAN
  62. NFIX=0
  63. ISGN=0
  64. IDEC=-1
  65. IEXP=0
  66. KSGN=1
  67. IF (IND.EQ.4) KSGN=-1
  68. IF (IND.NE.3.AND.IND.NE.4) GOTO 25
  69. 22 NRAN=NRAN+1
  70. IF(NRAN.GT.ICOUR) GOTO 30
  71. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  72. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  73. IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  74. IF (IND.NE.0) GOTO 25
  75. 24 CONTINUE
  76. NRAN=IDE
  77. IND=INDIN
  78. GOTO 60
  79. 25 IF(IND.LT.9.OR.IND.GT.18) GOTO 28
  80. ISGN=ISGN+1
  81. IF(IDEC.GE.0) IDEC=IDEC+1
  82. IF(ISGN-10) 26,252,255
  83. 252 MFIX=NFIX
  84. NFIX=0
  85. GOTO 26
  86. 255 IF(ISGN.LT.19) GOTO 26
  87. IF(IDEC.LT.0) IEXP=IEXP+1
  88. IF(IDEC.GE.0) IDEC=IDEC-1
  89. GOTO 22
  90. 26 NFIX=10*NFIX+IND-9
  91. GOTO 22
  92. 28 IF(IND.EQ.1) GOTO 30
  93. IF (IND.EQ.8) GOTO 29
  94. IF(IND.LE.7.AND.IND.GE.3) GOTO 300
  95. IF(IND.GT.18) GOTO 40
  96. GOTO 24
  97. 29 IF (IDEC.GE.0) GOTO 24
  98. IDEC=0
  99. GOTO 22
  100. 300 IF (IDEC.LT.0) NRAN=NRAN-1
  101. SEPARA=.TRUE.
  102. 30 IF (ISGN.EQ.0) GOTO 24
  103. IF (IDEC.GE.0) GOTO 40
  104. C
  105. C ON A LU UN ENTIER
  106. C
  107. NCAR=NRAN-IDE
  108. IRE=1
  109. IF(ISGN.GT.9) GOTO 40
  110. IF(KSGN.LT.0) NFIX=-NFIX
  111. FLOT=NFIX
  112. RETURN
  113. C
  114. C ON A LU UN FLOTTANT
  115. C
  116. 40 IRE=2
  117. FLOT=NFIX
  118. IF(ISGN.LT.10) GOTO 41
  119. DP=MFIX
  120. IF(ISGN.GT.18) ISGN=18
  121. FLOT=FLOT+DP*1D1**(ISGN-9)
  122. 41 IF(IDEC.LT.0) IDEC=0
  123. IEXP=IEXP-IDEC
  124. IF(IND.EQ.1) GOTO 55
  125. IF (IND.LE.7.AND.IND.GE.3) GOTO 550
  126. ISGN=1
  127. NFIX=0
  128. NRAN=NRAN+1
  129. IF (NRAN.GT.ICOUR) GOTO 53
  130. IND=INDEX(CARAC(3:4),TEXT(NRAN:NRAN))+2
  131. IF (IND.EQ.2) GOTO 305
  132. IF (IND.EQ.4) ISGN=-1
  133. 42 NRAN=NRAN+1
  134. IF(NRAN.GT.ICOUR) GOTO 53
  135. 305 CONTINUE
  136. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  137. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  138. IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  139. IF (IND.EQ.0) GOTO 24
  140. IF(IND.EQ.1) GOTO 52
  141. IF (IND.LE.7.AND.IND.GE.3) GOTO 520
  142. IF(IND.LT.9.OR.IND.GT.18) GOTO 24
  143. NFIX=10*NFIX+IND-9
  144. GOTO 42
  145. 52 NRAN1=NRAN-1
  146. IF (INDEX(CARAC(19:24),TEXT(NRAN1:NRAN1)).NE.0) GOTO 42
  147. GOTO 521
  148. 520 NRAN=NRAN-1
  149. SEPARA=.TRUE.
  150. 521 CONTINUE
  151. 53 IF(ISGN.LT.0) NFIX=-NFIX
  152. IEXP=IEXP+NFIX
  153. GOTO 55
  154. 550 NRAN=NRAN-1
  155. SEPARA=.TRUE.
  156. 55 FLOT=FLOT*1D1**IEXP
  157. IF(KSGN.LT.0) FLOT=-FLOT
  158. NCAR=NRAN-IDE
  159. RETURN
  160. C
  161. C ON A LU UN MOT OU UN TEXT
  162. C
  163. 60 MOT=' '
  164. IF (IND.EQ.2) GOTO 70
  165. C
  166. C ON A LU UN MOT
  167. C
  168. IRE=3
  169. IDEB=NRAN
  170. IF ((INDIN.LT.3.OR.INDIN.GT.8).AND.INDIN.NE.25) GOTO 66
  171. NRAN=NRAN+1
  172. IF (INDIN.NE.6) GOTO 68
  173. IF (NRAN.GT.ICOUR) GOTO 68
  174. IF (TEXT(NRAN:NRAN).NE.CARAC(6:6)) GOTO 68
  175. NRAN=NRAN+1
  176. GOTO 68
  177. 66 NRAN=NRAN+1
  178. IF(NRAN.GT.ICOUR) GOTO 68
  179. INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  180. IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  181. INDAUX=INDEX(CARAC,TEXT(NRAN:NRAN))
  182. IF (INDAUX.EQ.1.OR.INDAUX.EQ.2) GOTO 68
  183. IF ((INDAUX.LT.3.OR.INDAUX.GT.8).AND.INDAUX.NE.25) GOTO 66
  184. SEPARA=.TRUE.
  185. IFIN=NRAN-1
  186. GO TO 680
  187. 68 IFIN=NRAN-1
  188. SEPARA=.FALSE.
  189. 680 CONTINUE
  190. NCAR=IFIN-IDEB+1
  191. NCAR=MIN(72,NCAR)
  192. MOT(1:NCAR)=TEXT(IDEB:IFIN)
  193. NRAN=NRAN-1
  194. IF(MOT(1:1).EQ.'.') IRE=6
  195. IF(MOT(1:1).EQ.'%') IRE=7
  196. C
  197. C CE MOT EST-IL 'VRAI' OU 'FAUX' AUQUEL CAS ON A LU UN LOGIQUE
  198. C
  199. IF (MOT(1:5).EQ.'VRAI') THEN
  200. BOOL=.TRUE.
  201. IRE=5
  202. ELSEIF (MOT(1:5).EQ.'FAUX') THEN
  203. BOOL=.FALSE.
  204. IRE=5
  205. ENDIF
  206. RETURN
  207. 70 IRE=4
  208. NRAN=NRAN+1
  209. IDEB=NRAN
  210. 71 NRAN=NRAN+1
  211. IF (NRAN.GT.ICOUR) GOTO 72
  212. IF (TEXT(NRAN:NRAN).EQ.CARAC(2:2)) GOTO 72
  213. GOTO 71
  214. 72 IFIN=NRAN-1
  215. NCAR=IFIN-IDEB+1
  216. NCAR=MIN(72,NCAR)
  217. MOT(1:NCAR)=TEXT(IDEB:IFIN)
  218. RETURN
  219. 2 IRE=0
  220. RETURN
  221. END
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  

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