Numérotation des lignes :

C NOMTEX    SOURCE    JC220346  14/02/19    21:15:07     7941      SUBROUTINE NOMTEX      IMPLICIT INTEGER(I-N)      CHARACTER*(72) MESS,ICARB      CHARACTER*(8) CHAR      REAL*8 XPO-INC CCNOYAU-INC CCOPTIO-INC SMTEXTE      MESS=' '      ILON=0      IPP=0      IMT=0   1  CONTINUE      INTEXT=1      CALL QUETYP(CHAR,0,IRETOU)      IF(IRETOU.EQ.0) GO TO 10      IPP=IPP+1      IF(CHAR.NE.'TEXTE   ') GO TO 3      CALL LIROBJ(CHAR,MTEXTE,1,IRETOU)      IF(IERR.NE.0) GO TO 1010      IMT=IMT+1      SEGACT MTEXTE      IF(ILON+NCART.GT.72) GO TO 1000      MESS(ILON+1:ILON+NCART)=MTEXT(1:NCART)      ILON=ILON+NCART+1      SEGDES MTEXTE      GO TO 1   3  IF(CHAR.NE.'ENTIER  ') GO TO 4      CALL LIRENT(IPO,1,IRETOU)      IF(IERR.NE.0) GO TO 1010      IF(ILON+13.GT.72) GO TO 1000      IF(ABS(IPO).LT.10000) THEN      WRITE(MESS(ILON+1:ILON+7),FMT='(I5)') IPO      ILON=ILON+8      ELSE      WRITE(MESS(ILON+1:ILON+11),FMT='(I9)') IPO      ILON=ILON+12      ENDIF      GO TO 1   4  IF(CHAR.NE.'FLOTTANT')GO TO 5      CALL LIRREE(XPO,1,IRETOU)      IF(IERR.NE.0) GO TO 1010      IF( ILON +17.GT.72) GO TO 1000      WRITE(MESS(ILON+1:ILON+15),FMT='(E13.6)')XPO      ILON=ILON+16      GO TO 1   5  IF ((CHAR.NE.'MOT     ').AND.(CHAR.NE.'PROCEDUR')) GO TO 6         CALL LIRCHA(ICARB,1,IRETOU)         IF(IERR.NE.0) GOTO 1010         DO 25 IFI=72,1,-1         IF(ICARB(IFI:IFI).EQ.' ') GO TO 25         NCA=IFI         GO TO 26   25    CONTINUE         NCA = 1   26    CONTINUE         IF(ILON+NCA.GT.72) GO TO 1000         MESS(ILON+1:ILON+NCA)=ICARB(1:NCA)         ILON=ILON+NCA+1         GO TO 1   6  CALL REFUS  10  CONTINUE      IF(IMT.EQ.0.AND.IPP.EQ.0) THEN      CALL ERREUR ( 533)      ELSE      SEGINI MTEXTE      NCART=ILON      MTRADC=0      ILL = MAX(1,ILON)      MTEXT(1:ILL)=MESS(1:ILL)      SEGDES MTEXTE      CALL ECROBJ('TEXTE   ',MTEXTE)      IF(IIMPI.EQ.1756) WRITE(IOIMP,155) MTEXTE 155  FORMAT( '  DANS NOMTEX  SEGMENT NUMERO : ',I5)      ENDIF      INTEXT=1      RETURN1000  CONTINUE      CALL ERREUR(425)      RETURN1010  CONTINUE      CALL ERREUR (5)      RETURN      END

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