Télécharger anasyn.eso

Retour à la liste

Numérotation des lignes :

  1. C ANASYN SOURCE GF238795 17/11/15 19:12:11 9611
  2. C BUT : FOURNIR LA PHRASE ELEMENTAIRE A TRAITER
  3. C
  4. C SORTIE : IPEG LOGIQUE VRAI S'IL EXISTE UN SIGNE EGAL FAUX SINON
  5. C IPVIR=1 ON EST ARRIVE AU POINT-VIRGULE =0 SINON
  6. C
  7. C VARIABLES INTERNES : IDEB DEBUT DANS TEXTE DE LA PHRASE A TRAITER
  8. C IFINAN POSITION DU ;
  9. C
  10. C VARIABLES EXTERNES : IPREC POSITION DU PREMIER CARACTERE DE LA
  11. C PHRASE ELEMENTAIRE (CONTIENT LES NOMS A
  12. C AFFECTER).
  13. C ICOUR POSITION DU DERNIER CARACTERE.
  14. C IEGAL POSITION DU SIGNE = ( OU IPREC).
  15. C
  16. C LA PHRASE COMPLETE EST DANS TEXT.
  17. C
  18. C
  19. SUBROUTINE ANASYN(IPEG,IPVIR)
  20. IMPLICIT INTEGER (I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. -INC CCOPTIO
  23. -INC CCREDLE
  24. -INC CCNOYAU
  25. LOGICAL IPEG,ITXCR
  26. LOGICAL INIANA
  27. LOGICAL ITERM
  28. LOGICAL itx
  29. LOGICAL bGuil
  30. integer jpos
  31. SAVE ITERM,INIANA,ITXCR,IDEB
  32. C DIRECTIVE SUR 500 CARACTERES AU MAX
  33. CHARACTER*500 BUF
  34. CHARACTER*72 CTAMPO
  35. CHARACTER*26 MINU,MAJU
  36. DATA MINU/'abcdefghijklmnopqrstuvwxyz'/
  37. DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
  38. DATA ITERM/.FALSE./
  39. DATA INIANA/.TRUE./
  40. sredle=iredle
  41. IF (ITERM) THEN
  42. IERR=3
  43. CALL FIN
  44. ENDIF
  45. IPEG=.FALSE.
  46. IF (.NOT.INIANA.AND.IERR.EQ.0) THEN
  47. I1=IPREC+1
  48. IF (IDPAR.EQ.0) THEN
  49. I1=IPREC
  50. ENDIF
  51. I2=ICOUR-1
  52. IF (I1.EQ.1.AND.I2.EQ.IFINAN-1) THEN
  53. N=IPOS-IFINAN
  54. IF (N.NE.0) THEN
  55. IPAR=IFINAN+1
  56. BUF(1:N)=TEXT(IPAR:IPAR+N-1)
  57. TEXT(1:N)=BUF(1:N)
  58. ICOUR=1
  59. IDC=IDEB
  60. IPOS=N
  61. LGPTT=0
  62. LGETT=0
  63. GOTO 3
  64. ENDIF
  65. ELSE
  66. GOTO 100
  67. ENDIF
  68. ENDIF
  69. ITXCR=.FALSE.
  70. INIANA=.FALSE.
  71. IDEB=1
  72. ICOUR=1
  73. IFINAN=0
  74. 1 IPOS=IFINAN+1
  75. c write(6,*) 'Ipos vaut ',ipos
  76. IF (IPOS.GE.500) THEN
  77. c on va faire un deborder lors de la lecture : on sort en erreur
  78. c avant (427+72=500)
  79. moterr(1:40)=text(1:40)
  80. write(IOIMP,*) text
  81. CALL ERREUR(3)
  82. RETURN
  83. ENDIF
  84. IF (ITERM) THEN
  85. RETURN
  86. ENDIF
  87. CALL LIRECA
  88. c write(IOIMP,*)TEXT(IFINAN+1:IPOS)
  89. c write(6,*) 'Verif guille',IFINAN+1,IPOS
  90. bGuil=.FALSE.
  91. DO JPOS=IFINAN+1,IPOS
  92. c write(6,*) JPOS,TEXT(JPOS:JPOS)
  93. IF (TEXT(JPOS:JPOS).EQ.'''') THEN
  94. bGuil=.NOT.bGuil
  95. ENDIF
  96. ENDDO
  97. IF(bGuil) THEN
  98. write(IOIMP,*)TEXT(IFINAN+1:IPOS)
  99. call erreur (1071)
  100. GOTO 111
  101. ENDIF
  102. c write(6,*) TEXT(1:IPOS)
  103. IF (IPOS.EQ.IFINAN+1) THEN
  104. CALL ERREUR(4)
  105. IF (IFINAN.EQ.0) THEN
  106. CALL FIN
  107. ENDIF
  108. I=IFINAN
  109. ITERM=.TRUE.
  110. GOTO 10
  111. ENDIF
  112. IDC=IFINAN+1
  113. IF(.NOT.ITXCR) THEN
  114. C COMPACTAGE DE LA CARTE DE DONNEE
  115. DO KL=IDC,IPOS
  116. c On cherche la position du premier caractere non espace
  117. IF(TEXT(KL:KL).NE.' ') THEN
  118. IF(KL.EQ.IDC) THEN
  119. IDGD=KL
  120. ELSE
  121. IDGD=KL-1
  122. ENDIF
  123. GO TO 334
  124. ENDIF
  125. ENDDO
  126. C IL N'Y A QUE DES BLANCS
  127. GO TO 1
  128. c il faut comprendre goto 1 comme "on lit une nouvelle ligne"
  129. 334 DO KL=IPOS,IDC,-1
  130. c On cherche la position du dernier caractere non espace
  131. IF(TEXT(KL:KL).NE.' ') THEN
  132. IF(KL.EQ.IPOS) THEN
  133. IDGF=KL
  134. ELSE
  135. IDGF=KL+1
  136. ENDIF
  137. GO TO 336
  138. ENDIF
  139. ENDDO
  140. 336 CONTINUE
  141. IDLO= IDGF-IDGD+1
  142. IF(IDLO.NE.72)8/spal>0THEN
  143. CTAMPO(1:IDLO)=TEXT(IDGD:IDGF)
  144. IPOS=IFINAN+IDLO
  145. TEXT(IDC:IPOS)=CTAMPO(1:IDLO)
  146. ENDIF
  147. ENDIF
  148. C FIN DU COMPACTAGE
  149. 3 CONTINUE
  150. I = 0
  151. DO IAUX=IDC,IPOS
  152. IF (TEXT(IAUX:IAUX).EQ.'''') THEN
  153. ITXCR=.NOT.ITXCR
  154. ENDIF
  155. IF (.NOT.ITXCR) THEN
  156. * PASSAGE EN MAJUSCULE
  157. IRAL=INDEX(MINU,TEXT(IAUX:IAUX))
  158. IF (IRAL.NE.0) THEN
  159. TEXT(IAUX:IAUX)=MAJU(IRAL:IRAL)
  160. ENDIF
  161. IF (TEXT(IAUX:IAUX).EQ.';') THEN
  162. I = IAUX
  163. GO TO 124
  164. ENDIF
  165. ENDIF
  166. ENDDO
  167. 124 CONTINUE
  168. IF (I.EQ.0) THEN
  169. IFINAN=IPOS
  170. GOTO 1
  171. ENDIF
  172. 10 IFINAN=I
  173. IERR=0
  174. CALL RAZPIL
  175. IPREC=IDEB
  176. ICOUR=IDEB
  177. 100 ICAU=ICOUR
  178. IF (ICAU.LE.IFINAN) THEN
  179. ICOUR=ICAU-1
  180. DO IAUX=ICAU,IFINAN
  181. IF (TEXT(IAUX:IAUX).EQ.'''') THEN
  182. ITXCR=.NOT.ITXCR
  183. ENDIF
  184. IF (.NOT.ITXCR.AND.TEXT(IAUX:IAUX).EQ.')') THEN
  185. ICOUR = IAUX
  186. GO TO 114
  187. ENDIF
  188. ENDDO
  189. 114 CONTINUE
  190. IF (ICOUR.NE.(ICAU-1)) THEN
  191. IFPAR=1
  192. ELSE
  193. IFPAR=0
  194. ICOUR=IFINAN
  195. ENDIF
  196. ENDIF
  197. IDREC=ICOUR-1
  198. IF (IDREC.GE.0) THEN
  199. IDPAR=1
  200. ITXCR=.FALSE.
  201. DO IAUX=IDEB,IDREC
  202. IPREC=IDREC+IDEB-IAUX
  203. IF (TEXT(IPREC:IPREC).EQ.'''') THEN
  204. ITXCR=.NOT.ITXCR
  205. ENDIF
  206. IF (.NOT.ITXCR) THEN
  207. IF (TEXT(IPREC:IPREC).EQ.'=') THEN
  208. IPEG=.TRUE.
  209. IEGAL=IPREC
  210. ENDIF
  211. IF (TEXT(IPREC:IPREC).EQ.'(') GOTO 111
  212. ENDIF
  213. ENDDO
  214. ENDIF
  215. IPREC=1
  216. IDPAR=0
  217. 111 CONTINUE
  218. IF (.NOT.IPEG) THEN
  219. IEGAL = IPREC
  220. ENDIF
  221. moterr(1:40)=text(1:40)
  222. IF (IFPAR.EQ.0.AND.IDPAR.EQ.1) THEN
  223. CALL ERREUR(1)
  224. ENDIF
  225. IF (IDPAR.EQ.0.AND.IFPAR.EQ.1) THEN
  226. CALL ERREUR(2)
  227. ENDIF
  228. IF (IDPAR.EQ.1) THEN
  229. TEXT(IPREC:IPREC)=' '
  230. ENDIF
  231. TEXT(ICOUR:ICOUR)=' '
  232. IF (IIMPI.EQ.1) THEN
  233. WRITE (IOIMP,3000) (TEXT(IBO:IBO),IBO=IPREC,ICOUR)
  234. ENDIF
  235. NRAN=IPREC-1
  236. C EN ATTENDANT DE TROUVER MIEUX ------
  237. IF(ICOUR.EQ.IFINAN) THEN
  238. IPVIR= 1
  239. ENDIF
  240. ISTOP=0
  241. ieg=0
  242. itx=.false.
  243. do iaa=nran,icour
  244. if(TEXT(Iaa:Iaa).EQ.'''') then
  245. itx= .not.itx
  246. endif
  247. if(.not.itx.and.text(iaa:iaa).eq.'=') then
  248. ieg=ieg+1
  249. endif
  250. enddo
  251. if(ieg.ge.2) then
  252. call erreur (1014)
  253. return
  254. endif
  255. RETURN
  256. 3000 FORMAT (/,(' ANALYSE -',72A1))
  257. END
  258.  
  259.  
  260.  
  261.  

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