Numérotation des lignes :

anasyn
C ANASYN    SOURCE    PV        20/11/15    23:26:13     10785          C    BUT    :  FOURNIR LA PHRASE ELEMENTAIRE A TRAITERCC    SORTIE : IPEG  LOGIQUE VRAI S'IL EXISTE UN SIGNE EGAL FAUX SINONC             IPVIR=1 ON EST ARRIVE AU POINT-VIRGULE =0 SINONCC    VARIABLES INTERNES : IDEB  DEBUT DANS TEXTE DE LA PHRASE A TRAITERC                         IFINAN  POSITION DU ;CC    VARIABLES EXTERNES : IPREC  POSITION DU PREMIER CARACTERE DE LAC                         PHRASE ELEMENTAIRE (CONTIENT LES NOMS AC                         AFFECTER).C                         ICOUR  POSITION DU DERNIER CARACTERE.C                         IEGAL  POSITION DU SIGNE = ( OU IPREC).CC    LA PHRASE COMPLETE EST DANS TEXT.CC      SUBROUTINE ANASYN(IPEG,IPVIR)       IMPLICIT INTEGER (I-N)      IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM-INC CCOPTIO-INC CCREDLE-INC CCNOYAU       LOGICAL IPEG,ITXCR      LOGICAL INIANA      LOGICAL ITERM      LOGICAL itx      LOGICAL bGuil      integer jpos      SAVE ITERM,INIANA,ITXCR,IDEBC   DIRECTIVE SUR LOCHAI CARACTERES AU MAX      CHARACTER*(LOCHAI) BUF,CTAMPO      CHARACTER*26 MINU,MAJU      DATA MINU/'abcdefghijklmnopqrstuvwxyz'/      DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/      DATA ITERM/.FALSE./      DATA INIANA/.TRUE./       sredle=iredle      IF (ITERM) THEN        IERR=3        CALL FIN      ENDIF      IPEG=.FALSE.      IF (.NOT.INIANA.AND.IERR.EQ.0) THEN        I1=IPREC+1        IF (IDPAR.EQ.0) THEN          I1=IPREC        ENDIF        I2=ICOUR-1        IF (I1.EQ.1.AND.I2.EQ.IFINAN-1) THEN          N=IPOS-IFINAN          IF (N.NE.0) THEN            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          ENDIF        ELSE          GOTO 100        ENDIF      ENDIF      ITXCR=.FALSE.      INIANA=.FALSE.      IDEB=1      ICOUR=1      IFINAN=0   1  IPOS=IFINAN+1c      write(6,*) 'Ipos vaut ',ipos      IF (IPOS.GE.500) THENc      on va faire un deborder lors de la lecture : on sort en erreurc      avant (427+72=500)        moterr(1:40)=text(1:40)        write(IOIMP,*) text        CALL ERREUR(3)        RETURN      ENDIF      IF (ITERM) THEN        RETURN      ENDIF      CALL LIRECAc          write(IOIMP,*)TEXT(IFINAN+1:IPOS)c      write(6,*) 'Verif guille',IFINAN+1,IPOS      bGuil=.FALSE.        DO JPOS=IFINAN+1,IPOSc            write(6,*) JPOS,TEXT(JPOS:JPOS)          IF (TEXT(JPOS:JPOS).EQ.'''') THEN            bGuil=.NOT.bGuil          ENDIF        ENDDO        IF(bGuil) THEN          write(IOIMP,*)TEXT(IFINAN+1:IPOS)          call erreur (1071)        GOTO 111        ENDIFc          write(6,*) TEXT(1:IPOS)      IF (IPOS.EQ.IFINAN+1) THEN        CALL ERREUR(4)        IF (IFINAN.EQ.0) THEN          CALL FIN        ENDIF        I=IFINAN        ITERM=.TRUE.        GOTO 10      ENDIF      IDC=IFINAN+1      IF(.NOT.ITXCR) THENC  COMPACTAGE DE LA CARTE DE DONNEE        DO  KL=IDC,IPOSc On cherche la position du premier caractere non espace         IF(TEXT(KL:KL).NE.' ') THEN            IF(KL.EQ.IDC) THEN              IDGD=KL            ELSE              IDGD=KL-1            ENDIF            GO TO 334         ENDIF        ENDDOC  IL N'Y A QUE DES BLANCS        GO TO 1c il faut comprendre goto 1 comme "on lit une nouvelle ligne" 334    DO  KL=IPOS,IDC,-1c On cherche la position du dernier caractere non espace          IF(TEXT(KL:KL).NE.' ') THEN            IF(KL.EQ.IPOS) THEN              IDGF=KL            ELSE              IDGF=KL+1            ENDIF            GO TO 336          ENDIF        ENDDO  336   CONTINUE        IDLO= IDGF-IDGD+1         IF(IDLO.LE.500) THEN          CTAMPO(1:IDLO)=TEXT(IDGD:IDGF)          IPOS=IFINAN+IDLO          TEXT(IDC:IPOS)=CTAMPO(1:IDLO)        else          call erreur(5)        ENDIF      ENDIFC  FIN DU COMPACTAGE   3  CONTINUE      I = 0      DO IAUX=IDC,IPOS        IF (TEXT(IAUX:IAUX).EQ.'''') THEN          ITXCR=.NOT.ITXCR        ENDIF        IF (.NOT.ITXCR) THEN*  PASSAGE EN MAJUSCULE          IRAL=INDEX(MINU,TEXT(IAUX:IAUX))          IF (IRAL.NE.0) THEN            TEXT(IAUX:IAUX)=MAJU(IRAL:IRAL)          ENDIF          IF (TEXT(IAUX:IAUX).EQ.';') THEN            I = IAUX            GO TO 124          ENDIF        ENDIF      ENDDO 124  CONTINUE      IF (I.EQ.0) THEN        IFINAN=IPOS        GOTO 1      ENDIF  10  IFINAN=I      IERR=0      IERGLB=0      CALL RAZPIL      IPREC=IDEB      ICOUR=IDEB 100  ICAU=ICOUR      IF (ICAU.LE.IFINAN) THEN        ICOUR=ICAU-1        DO IAUX=ICAU,IFINAN          IF (TEXT(IAUX:IAUX).EQ.'''') THEN            ITXCR=.NOT.ITXCR          ENDIF          IF (.NOT.ITXCR.AND.TEXT(IAUX:IAUX).EQ.')') THEN            ICOUR = IAUX            GO TO 114          ENDIF        ENDDO 114    CONTINUE        IF (ICOUR.NE.(ICAU-1)) THEN          IFPAR=1        ELSE          IFPAR=0          ICOUR=IFINAN        ENDIF      ENDIF      IDREC=ICOUR-1      IF (IDREC.GE.0) THEN        IDPAR=1        ITXCR=.FALSE.        DO IAUX=IDEB,IDREC          IPREC=IDREC+IDEB-IAUX          IF (TEXT(IPREC:IPREC).EQ.'''') THEN            ITXCR=.NOT.ITXCR          ENDIF          IF (.NOT.ITXCR) THEN            IF (TEXT(IPREC:IPREC).EQ.'=') THEN              IPEG=.TRUE.              IEGAL=IPREC            ENDIF            IF (TEXT(IPREC:IPREC).EQ.'(') GOTO 111          ENDIF        ENDDO      ENDIF      IPREC=1      IDPAR=0 111  CONTINUE      IF (.NOT.IPEG) THEN        IEGAL = IPREC      ENDIF      moterr(1:40)=text(1:40)      IF (IFPAR.EQ.0.AND.IDPAR.EQ.1) THEN        CALL ERREUR(1)      ENDIF      IF (IDPAR.EQ.0.AND.IFPAR.EQ.1) THEN        CALL ERREUR(2)      ENDIF      IF (IDPAR.EQ.1) THEN        TEXT(IPREC:IPREC)=' '      ENDIF      TEXT(ICOUR:ICOUR)=' '      IF (IIMPI.EQ.1) THEN        WRITE (IOIMP,3000) (TEXT(IBO:IBO),IBO=IPREC,ICOUR)      ENDIF      NRAN=IPREC-1C   EN ATTENDANT DE TROUVER MIEUX   ------      IF(ICOUR.EQ.IFINAN) THEN        IPVIR= 1      ENDIF      ISTOP=0      ieg=0      itx=.false.      do iaa=nran,icour        if(TEXT(Iaa:Iaa).EQ.'''') then          itx= .not.itx        endif        if(.not.itx.and.text(iaa:iaa).eq.'=')  then            ieg=ieg+1        endif      enddo      if(ieg.ge.2)  then        call erreur (1014)        return      endif      RETURN 3000 FORMAT (/,(' ANALYSE -',72A1))      END      

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