1 : C NOMTEX SOURCE JC220346 14/02/19 21:15:07 7941 2 : SUBROUTINE NOMTEX 3 : IMPLICIT INTEGER(I-N) 4 : CHARACTER*(72) MESS,ICARB 5 : CHARACTER*(8) CHAR 6 : REAL*8 XPO 7 : -INC CCNOYAU 8 : -INC CCOPTIO 9 : -INC SMTEXTE 10 : MESS=' ' 11 : ILON=0 12 : IPP=0 13 : IMT=0 14 : 1 CONTINUE 15 : INTEXT=1 15 : CALL QUETYP(CHAR,0,IRETOU) 16 : IF(IRETOU.EQ.0) GO TO 10 17 : IPP=IPP+1 18 : IF(CHAR.NE.'TEXTE ') GO TO 3 18 : CALL LIROBJ(CHAR,MTEXTE,1,IRETOU) 19 : IF(IERR.NE.0) GO TO 1010 20 : IMT=IMT+1 21 : SEGACT MTEXTE 22 : IF(ILON+NCART.GT.72) GO TO 1000 23 : MESS(ILON+1:ILON+NCART)=MTEXT(1:NCART) 24 : ILON=ILON+NCART+1 25 : SEGDES MTEXTE 26 : GO TO 1 27 : 3 IF(CHAR.NE.'ENTIER ') GO TO 4 27 : CALL LIRENT(IPO,1,IRETOU) 28 : IF(IERR.NE.0) GO TO 1010 29 : IF(ILON+13.GT.72) GO TO 1000 30 : IF(ABS(IPO).LT.10000) THEN 31 : WRITE(MESS(ILON+1:ILON+7),FMT='(I5)') IPO 32 : ILON=ILON+8 33 : ELSE 34 : WRITE(MESS(ILON+1:ILON+11),FMT='(I9)') IPO 35 : ILON=ILON+12 36 : ENDIF 37 : GO TO 1 38 : 4 IF(CHAR.NE.'FLOTTANT')GO TO 5 38 : CALL LIRREE(XPO,1,IRETOU) 39 : IF(IERR.NE.0) GO TO 1010 40 : IF( ILON +17.GT.72) GO TO 1000 41 : WRITE(MESS(ILON+1:ILON+15),FMT='(E13.6)')XPO 42 : ILON=ILON+16 43 : GO TO 1 44 : 5 IF ((CHAR.NE.'MOT ').AND.(CHAR.NE.'PROCEDUR')) GO TO 6 44 : CALL LIRCHA(ICARB,1,IRETOU) 45 : IF(IERR.NE.0) GOTO 1010 46 : DO 25 IFI=72,1,-1 47 : IF(ICARB(IFI:IFI).EQ.' ') GO TO 25 48 : NCA=IFI 49 : GO TO 26 50 : 25 CONTINUE 51 : NCA = 1 52 : 26 CONTINUE 53 : IF(ILON+NCA.GT.72) GO TO 1000 54 : MESS(ILON+1:ILON+NCA)=ICARB(1:NCA) 55 : ILON=ILON+NCA+1 56 : GO TO 1 56 : 6 CALL REFUS 57 : 10 CONTINUE 58 : IF(IMT.EQ.0.AND.IPP.EQ.0) THEN 58 : CALL ERREUR ( 533) 59 : ELSE 60 : SEGINI MTEXTE 61 : NCART=ILON 62 : MTRADC=0 63 : ILL = MAX(1,ILON) 64 : MTEXT(1:ILL)=MESS(1:ILL) 65 : SEGDES MTEXTE 65 : CALL ECROBJ('TEXTE ',MTEXTE) 66 : IF(IIMPI.EQ.1756) WRITE(IOIMP,155) MTEXTE 67 : 155 FORMAT( ' DANS NOMTEX SEGMENT NUMERO : ',I5) 68 : ENDIF 69 : INTEXT=1 70 : RETURN 71 : 1000 CONTINUE 71 : CALL ERREUR(425) 72 : RETURN 73 : 1010 CONTINUE 73 : CALL ERREUR (5) 74 : RETURN 75 : END 76 : 77 :
© Cast3M 2003 - All rights reserved.
Disclaimer