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 PPARAM -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 RETURN 1000 CONTINUE CALL ERREUR(425) RETURN 1010 CONTINUE CALL ERREUR (5) RETURN END