C ANASYN SOURCE CHAT 11/05/31 21:15:00 6991 C BUT : FOURNIR LA PHRASE ELEMENTAIRE A TRAITER C C SORTIE : IPEG LOGIQUE VRAI S'IL EXISTE UN SIGNE EGAL FAUX SINON C IPVIR=1 ON EST ARRIVE AU POINT-VIRGULE =0 SINON C C VARIABLES INTERNES : IDEB DEBUT DANS TEXTE DE LA PHRASE A TRAITER C IFINAN POSITION DU ; C C VARIABLES EXTERNES : IPREC POSITION DU PREMIER CARACTERE DE LA C PHRASE ELEMENTAIRE (CONTIENT LES NOMS A C AFFECTER). C ICOUR POSITION DU DERNIER CARACTERE. C IEGAL POSITION DU SIGNE = ( OU IPREC). C C LA PHRASE COMPLETE EST DANS TEXT. C C SUBROUTINE ANASYN(IPEG,IPVIR) IMPLICIT INTEGER(I-N) -INC CCREDLE -INC CCOPTIO -INC CCNOYAU SAVE ITERM,INIANA,ITXCR,IDEB LOGICAL IPEG,ITXCR C DIRECTIVE SUR 500 CARACTERES AU MAX CHARACTER*500 BUF CHARACTER*72 CTAMPO CHARACTER*26 MINU,MAJU DATA MINU/'abcdefghijklmnopqrstuvwxyz'/ DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ DATA ITERM/0/ DATA INIANA/0/ sredle=iredle IF (ITERM.EQ.1) THEN IERR=3 CALL FIN ENDIF IPEG=.FALSE. IF (INIANA.EQ.0) GOTO 4 IF (IERR.EQ.0) GOTO 201 4 CONTINUE ITXCR=.FALSE. INIANA=1 IDEB=1 ICOUR=1 IFINAN=0 1 IPOS=IFINAN+1 IF (IPOS.GT.427) GOTO 1000 IF (ITERM.NE.0) RETURN CALL LIRECA IF (IPOS.EQ.IFINAN+1) GOTO 1001 IDC=IFINAN+1 IF(.NOT.ITXCR) THEN C COMPACTAGE DE LA CARTE DE DONNEE DO 333 KL=IDC,IPOS IF(TEXT(KL:KL).EQ.' ') GO TO 333 IDGD=KL IF(IDGD.NE.IDC) IDGD=IDGD-1 GO TO 334 333 CONTINUE C IL N'Y A QUE DES BLANCS GO TO 1 334 DO 335 KL=IPOS,IDC,-1 IF(TEXT(KL:KL).EQ.' ') GO TO 335 IDGF=KL IF(IDGF.NE.IPOS) IDGF=IDGF+1 GO TO 336 335 CONTINUE 336 CONTINUE IDLO= IDGF-IDGD+1 IF(IDLO.EQ.72) GO TO 339 CTAMPO(1:IDLO)=TEXT(IDGD:IDGF) IPOS=IFINAN+IDLO TEXT(IDC:IPOS)=CTAMPO(1:IDLO) 339 CONTINUE ENDIF C FIN DU COMPACTAGE 3 CONTINUE I = 0 DO 123 IAUX=IDC,IPOS IF (TEXT(IAUX:IAUX).EQ.'''') ITXCR=.NOT.ITXCR IF (ITXCR) GOTO 123 * PASSAGE EN MAJUSCULE IRAL=INDEX(MINU,TEXT(IAUX:IAUX)) IF (IRAL.NE.0) TEXT(IAUX:IAUX)=MAJU(IRAL:IRAL) IF (TEXT(IAUX:IAUX).NE.';') GOTO 123 I = IAUX GO TO 124 123 CONTINUE 124 CONTINUE IF (I.NE.0) GOTO 10 IFINAN=IPOS GOTO 1 10 IFINAN=I IERR=0 CALL RAZPIL IPREC=IDEB ICOUR=IDEB GO TO 100 200 N=IPOS-IFINAN IF (N.EQ.0) GOTO 4 IPAR=IFINAN+1 BUF(1:N)=TEXT(IPAR:IPAR+N-1) TEXT(1:N)=BUF(1:N) ICOUR=1 IDC=IDEB IPOS=N LGPTT=0 LGETT=0 GOTO 3 100 ICAU=ICOUR IF (ICAU.GT.IFINAN) GOTO 102 ICOUR=ICAU-1 DO 113 IAUX=ICAU,IFINAN IF (TEXT(IAUX:IAUX).EQ.'''') ITXCR=.NOT.ITXCR IF (ITXCR) GOTO 113 IF (TEXT(IAUX:IAUX).NE.')') GOTO 113 ICOUR = IAUX GO TO 114 113 CONTINUE 114 CONTINUE IF (ICOUR.NE.(ICAU-1)) THEN IFPAR=1 ELSE IFPAR=0 ICOUR=IFINAN ENDIF 102 IDREC=ICOUR-1 IF (IDREC.LT.0) GOTO 110 IDPAR=1 ITXCR=.FALSE. DO 103 IAUX=IDEB,IDREC IPREC=IDREC+IDEB-IAUX IF (TEXT(IPREC:IPREC).EQ.'''') ITXCR=.NOT.ITXCR IF (ITXCR) GOTO 103 IF (TEXT(IPREC:IPREC).NE.'=') GOTO 105 IPEG=.TRUE. IEGAL=IPREC 105 IF (TEXT(IPREC:IPREC).EQ.'(') GOTO 111 103 CONTINUE 110 IPREC=1 IDPAR=0 111 CONTINUE IF (.NOT.IPEG) IEGAL = IPREC moterr(1:40)=text(1:40) IF (IFPAR.EQ.0.AND.IDPAR.EQ.1) CALL ERREUR(1) IF (IDPAR.EQ.0.AND.IFPAR.EQ.1) CALL ERREUR(2) IF (IDPAR.EQ.1) TEXT(IPREC:IPREC)=' ' TEXT(ICOUR:ICOUR)=' ' IF (IIMPI.NE.1) GOTO 104 WRITE (IOIMP,3000) (TEXT(IBO:IBO),IBO=IPREC,ICOUR) 3000 FORMAT (/,(' ANALYSE -',72A1)) 104 NRAN=IPREC-1 C EN ATTENDANT DE TROUVER MIEUX ------ IF(ICOUR.EQ.IFINAN) IPVIR= 1 ISTOP=0 ieg=0 itx=0 do iaa=nran,icour if(TEXT(Iaa:Iaa).EQ.'''') itx= itx+1 if( itx.ge.2) itx=0 if(itx.eq.0) then if( text(iaa:iaa).eq.'=') ieg=ieg+1 endif enddo if(ieg.ge.2) then call erreur (1014) return * go to 4 endif RETURN 201 CONTINUE I1=IPREC+1 IF (IDPAR.EQ.0) I1=IPREC I2=ICOUR-1 IL=I1-I2-1 IF (I1.EQ.1.AND.I2.EQ.IFINAN-1) GOTO 200 GOTO 100 1000 moterr(1:40)=text(1:40) write(6,*) text(1:72),text(73:144),text(145:216) CALL ERREUR(3) * GOTO 4 return 1001 CALL ERREUR(4) IF (IFINAN.EQ.0) CALL FIN I=IFINAN ITERM=1 GOTO 10 END