Télécharger anasyn.eso

Retour à la liste

Numérotation des lignes :

  1. C ANASYN SOURCE CHAT 11/05/31 21:15:00 6991
  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. -INC CCREDLE
  22. -INC CCOPTIO
  23. -INC CCNOYAU
  24. SAVE ITERM,INIANA,ITXCR,IDEB
  25. LOGICAL IPEG,ITXCR
  26. C DIRECTIVE SUR 500 CARACTERES AU MAX
  27. CHARACTER*500 BUF
  28. CHARACTER*72 CTAMPO
  29. CHARACTER*26 MINU,MAJU
  30. DATA MINU/'abcdefghijklmnopqrstuvwxyz'/
  31. DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
  32. DATA ITERM/0/
  33. DATA INIANA/0/
  34. sredle=iredle
  35. IF (ITERM.EQ.1) THEN
  36. IERR=3
  37. CALL FIN
  38. ENDIF
  39. IPEG=.FALSE.
  40. IF (INIANA.EQ.0) GOTO 4
  41. IF (IERR.EQ.0) GOTO 201
  42. 4 CONTINUE
  43. ITXCR=.FALSE.
  44. INIANA=1
  45. IDEB=1
  46. ICOUR=1
  47. IFINAN=0
  48. 1 IPOS=IFINAN+1
  49. IF (IPOS.GT.427) GOTO 1000
  50. IF (ITERM.NE.0) RETURN
  51. CALL LIRECA
  52. IF (IPOS.EQ.IFINAN+1) GOTO 1001
  53. IDC=IFINAN+1
  54. IF(.NOT.ITXCR) THEN
  55. C COMPACTAGE DE LA CARTE DE DONNEE
  56. DO 333 KL=IDC,IPOS
  57. IF(TEXT(KL:KL).EQ.' ') GO TO 333
  58. IDGD=KL
  59. IF(IDGD.NE.IDC) IDGD=IDGD-1
  60. GO TO 334
  61. 333 CONTINUE
  62. C IL N'Y A QUE DES BLANCS
  63. GO TO 1
  64. 334 DO 335 KL=IPOS,IDC,-1
  65. IF(TEXT(KL:KL).EQ.' ') GO TO 335
  66. IDGF=KL
  67. IF(IDGF.NE.IPOS) IDGF=IDGF+1
  68. GO TO 336
  69. 335 CONTINUE
  70. 336 CONTINUE
  71. IDLO= IDGF-IDGD+1
  72. IF(IDLO.EQ.72) GO TO 339
  73. CTAMPO(1:IDLO)=TEXT(IDGD:IDGF)
  74. IPOS=IFINAN+IDLO
  75. TEXT(IDC:IPOS)=CTAMPO(1:IDLO)
  76. 339 CONTINUE
  77. ENDIF
  78. C FIN DU COMPACTAGE
  79. 3 CONTINUE
  80. I = 0
  81. DO 123 IAUX=IDC,IPOS
  82. IF (TEXT(IAUX:IAUX).EQ.'''') ITXCR=.NOT.ITXCR
  83. IF (ITXCR) GOTO 123
  84. * PASSAGE EN MAJUSCULE
  85. IRAL=INDEX(MINU,TEXT(IAUX:IAUX))
  86. IF (IRAL.NE.0) TEXT(IAUX:IAUX)=MAJU(IRAL:IRAL)
  87. IF (TEXT(IAUX:IAUX).NE.';') GOTO 123
  88. I = IAUX
  89. GO TO 124
  90. 123 CONTINUE
  91. 124 CONTINUE
  92. IF (I.NE.0) GOTO 10
  93. IFINAN=IPOS
  94. GOTO 1
  95. 10 IFINAN=I
  96. IERR=0
  97. CALL RAZPIL
  98. IPREC=IDEB
  99. ICOUR=IDEB
  100. GO TO 100
  101. 200 N=IPOS-IFINAN
  102. IF (N.EQ.0) GOTO 4
  103. IPAR=IFINAN+1
  104. BUF(1:N)=TEXT(IPAR:IPAR+N-1)
  105. TEXT(1:N)=BUF(1:N)
  106. ICOUR=1
  107. IDC=IDEB
  108. IPOS=N
  109. LGPTT=0
  110. LGETT=0
  111. GOTO 3
  112. 100 ICAU=ICOUR
  113. IF (ICAU.GT.IFINAN) GOTO 102
  114. ICOUR=ICAU-1
  115. DO 113 IAUX=ICAU,IFINAN
  116. IF (TEXT(IAUX:IAUX).EQ.'''') ITXCR=.NOT.ITXCR
  117. IF (ITXCR) GOTO 113
  118. IF (TEXT(IAUX:IAUX).NE.')') GOTO 113
  119. ICOUR = IAUX
  120. GO TO 114
  121. 113 CONTINUE
  122. 114 CONTINUE
  123. IF (ICOUR.NE.(ICAU-1)) THEN
  124. IFPAR=1
  125. ELSE
  126. IFPAR=0
  127. ICOUR=IFINAN
  128. ENDIF
  129. 102 IDREC=ICOUR-1
  130. IF (IDREC.LT.0) GOTO 110
  131. IDPAR=1
  132. ITXCR=.FALSE.
  133. DO 103 IAUX=IDEB,IDREC
  134. IPREC=IDREC+IDEB-IAUX
  135. IF (TEXT(IPREC:IPREC).EQ.'''') ITXCR=.NOT.ITXCR
  136. IF (ITXCR) GOTO 103
  137. IF (TEXT(IPREC:IPREC).NE.'=') GOTO 105
  138. IPEG=.TRUE.
  139. IEGAL=IPREC
  140. 105 IF (TEXT(IPREC:IPREC).EQ.'(') GOTO 111
  141. 103 CONTINUE
  142. 110 IPREC=1
  143. IDPAR=0
  144. 111 CONTINUE
  145. IF (.NOT.IPEG) IEGAL = IPREC
  146. moterr(1:40)=text(1:40)
  147. IF (IFPAR.EQ.0.AND.IDPAR.EQ.1) CALL ERREUR(1)
  148. IF (IDPAR.EQ.0.AND.IFPAR.EQ.1) CALL ERREUR(2)
  149. IF (IDPAR.EQ.1) TEXT(IPREC:IPREC)=' '
  150. TEXT(ICOUR:ICOUR)=' '
  151. IF (IIMPI.NE.1) GOTO 104
  152. WRITE (IOIMP,3000) (TEXT(IBO:IBO),IBO=IPREC,ICOUR)
  153. 3000 FORMAT (/,(' ANALYSE -',72A1))
  154. 104 NRAN=IPREC-1
  155. C EN ATTENDANT DE TROUVER MIEUX ------
  156. IF(ICOUR.EQ.IFINAN) IPVIR= 1
  157. ISTOP=0
  158. ieg=0
  159. itx=0
  160. do iaa=nran,icour
  161. if(TEXT(Iaa:Iaa).EQ.'''') itx= itx+1
  162. if( itx.ge.2) itx=0
  163. if(itx.eq.0) then
  164. if( text(iaa:iaa).eq.'=') ieg=ieg+1
  165. endif
  166. enddo
  167. if(ieg.ge.2) then
  168. call erreur (1014)
  169. return
  170. * go to 4
  171. endif
  172. RETURN
  173. 201 CONTINUE
  174. I1=IPREC+1
  175. IF (IDPAR.EQ.0) I1=IPREC
  176. I2=ICOUR-1
  177. IL=I1-I2-1
  178. IF (I1.EQ.1.AND.I2.EQ.IFINAN-1) GOTO 200
  179. GOTO 100
  180. 1000 moterr(1:40)=text(1:40)
  181. write(6,*) text(1:72),text(73:144),text(145:216)
  182. CALL ERREUR(3)
  183.  
  184. * GOTO 4
  185. return
  186. 1001 CALL ERREUR(4)
  187. IF (IFINAN.EQ.0) CALL FIN
  188. I=IFINAN
  189. ITERM=1
  190. GOTO 10
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  

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