1 : C LTITRE SOURCE CHAT 05/01/13 01:25:48 5004 2 : SUBROUTINE LTITRE 3 : IMPLICIT INTEGER(I-N) 4 : CHARACTER*72 ICARB 5 : CHARACTER*(8) ICAR 6 : REAL*8 XPO 7 : -INC SMTEXTE 8 : -INC CCOPTIO 9 : TITREE=' ' 10 : ILON=0 11 : 1 CONTINUE 11 : CALL QUETYP(ICAR,0,IRETOU) 12 : IF(IRETOU.EQ.0) GO TO 10 13 : IF(ICAR.EQ.'ENTIER ')THEN 13 : CALL LIRENT(IPO,1,IRETOU) 14 : IF(IERR.NE.0) GO TO 1010 15 : IF(ABS(IPO).LT.10000) THEN 16 : IF(ILON+6.GT.72) GO TO 1000 17 : WRITE(TITREE(ILON+1:ILON+5),FMT='(I5)') IPO 18 : ILON=ILON+6 19 : ELSE 20 : IF(ILON+12.GT.72) GO TO 1000 21 : WRITE(TITREE(ILON+1:ILON+11),FMT='(I9)') IPO 22 : ILON=ILON+12 23 : ENDIF 24 : GO TO 1 25 : ELSEIF (ICAR.EQ.'FLOTTANT') THEN 25 : CALL LIRREE(XPO,1,IRETOU) 26 : IF(IERR.NE.0) GO TO 1010 27 : IF( ILON +13.GT.500) GO TO 1000 28 : WRITE(TITREE(ILON+1:ILON+12),FMT='(1PG12.5)')XPO 29 : ILON=ILON+13 30 : GO TO 1 31 : ELSEIF(ICAR.EQ.'MOT ') THEN 31 : CALL LIRCHA(ICARB,1,IRETOU) 32 : IF(IERR.NE.0) GOTO 1010 33 : DO 25 IFI=72,1,-1 34 : IF(ICARB(IFI:IFI).NE.' ') GO TO 26 35 : 25 CONTINUE 36 : 26 IFI=IFI+1 37 : IFI=MIN(IFI,72) 38 : IF(ILON+IFI.GT.72) GO TO 1000 39 : TITREE(ILON+1:ILON+IFI)=ICARB(1:IFI) 40 : ILON=ILON+IFI 41 : GO TO 1 42 : ENDIF 43 : 10 CONTINUE 44 : RETURN 45 : 1000 CONTINUE 45 : CALL ERREUR(425) 46 : RETURN 47 : 1010 CONTINUE 47 : CALL ERREUR(5) 48 : RETURN 49 : END 50 :
© Cast3M 2003 - All rights reserved.
Disclaimer