1 : C MESSAG SOURCE JC220346 14/02/19 21:15:04 7941 2 : SUBROUTINE MESSAG 3 : IMPLICIT INTEGER(I-N) 4 : CHARACTER*500 MESS 5 : CHARACTER*500 ICARB 6 : CHARACTER*(8) ICAR 7 : REAL*8 XPO 8 : external long 9 : -INC SMTEXTE 10 : -INC CCOPTIO 11 : -INC CCNOYAU 12 : MESS=' ' 13 : ILON=0 14 : 1 CONTINUE 14 : CALL QUETYP( ICAR,0,IRETOU) 15 : IF( IRETOU.EQ.0) GOTO 10 16 : IF(ICAR.EQ.'ENTIER ') THEN 16 : CALL LIRENT(IPO,0,IRETOU) 17 : IF(IRETOU.EQ.0) THEN 17 : CALL ERREUR(5) 18 : RETURN 19 : ENDIF 20 : IF(ILON+13.GT.500) GO TO 1000 21 : IF(ABS(IPO).LT.10000) THEN 22 : WRITE(MESS(ILON+1:ILON+7),FMT='(I5)') IPO 23 : ILON=ILON+8 24 : ELSE 25 : WRITE(MESS(ILON+1:ILON+11),FMT='(I9)') IPO 26 : ILON=ILON+12 27 : ENDIF 28 : ELSEIF( ICAR.EQ.'FLOTTANT') THEN 28 : CALL LIRREE(XPO,0,IRETOU) 29 : IF(IRETOU.EQ.0) THEN 29 : CALL ERREUR(5) 30 : RETURN 31 : ENDIF 32 : IF( ILON +17.GT.500) GO TO 1000 33 : WRITE(MESS(ILON+1:ILON+15),FMT='(1PG12.5)')XPO 34 : ILON=ILON+16 35 : ELSEIF ((ICAR.EQ.'MOT ').OR.(ICAR.EQ.'PROCEDUR')) THEN 35 : CALL LIRCHA(ICARB,0,IRETOU) 36 : IF(IRETOU.EQ.0) THEN 36 : CALL ERREUR(5) 37 : RETURN 38 : ENDIF 39 : IFI=MIN(IRETOU,500) 40 : IF(ILON+IFI.GT.500) GO TO 1000 41 : MESS(ILON+1:ILON+IFI)=ICARB(1:IFI) 42 : ILON=ILON+IFI 43 : ELSEIF( ICAR.EQ.'TEXTE ') THEN 43 : CALL LIROBJ('TEXTE ',IPO,0,IRETOU) 44 : IF(IRETOU.EQ.0) THEN 44 : CALL ERREUR(5) 45 : RETURN 46 : ENDIF 47 : MTEXTE = IPO 48 : SEGACT MTEXTE 49 : IF(ILON+NCART.GT.500) GO TO 1000 50 : MESS(ILON+1:ILON+NCART)=MTEXT(1:NCART) 51 : ILON=ILON+NCART 52 : SEGDES MTEXTE 53 : ELSE 53 : CALL ERREUR (21) 54 : RETURN 55 : ENDIF 56 : GO TO 1 57 : 10 CONTINUE 58 : INTEXT = 0 59 : ILON=LONG(MESS(1:ILON)) 60 : DO 12 J=1,MIN(ILON,500-132),133 61 : WRITE(IOIMP,11) MESS (J:MIN(J+132,ILON)) 62 : 11 FORMAT(1X,A) 63 : 12 CONTINUE 64 : RETURN 65 : 1000 CONTINUE 65 : CALL ERREUR(274) 66 : RETURN 67 : END 68 : 69 :
© Cast3M 2003 - All rights reserved.
Disclaimer