Télécharger messag.eso

Retour à la liste

Numérotation des lignes :

  1. C MESSAG SOURCE GF238795 17/09/29 21:15:37 9575
  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
  15. CALL QUETYP( ICAR,0,IRETOU)
  16. IF( IRETOU.EQ.0) GOTO 10
  17. IF(ICAR.EQ.'ENTIER ') THEN
  18. CALL LIRENT(IPO,0,IRETOU)
  19. IF(IRETOU.EQ.0) THEN
  20. CALL ERREUR(5)
  21. RETURN
  22. ENDIF
  23. IF(ILON+13.GT.500) GO TO 1000
  24. IF(ABS(IPO).LT.10000) THEN
  25. WRITE(MESS(ILON+1:ILON+7),FMT='(I5)') IPO
  26. ILON=ILON+8
  27. ELSE
  28. WRITE(MESS(ILON+1:ILON+11),FMT='(I9)') IPO
  29. ILON=ILON+12
  30. ENDIF
  31. ELSEIF( ICAR.EQ.'FLOTTANT') THEN
  32. CALL LIRREE(XPO,0,IRETOU)
  33. IF(IRETOU.EQ.0) THEN
  34. CALL ERREUR(5)
  35. RETURN
  36. ENDIF
  37. IF( ILON +17.GT.500) GO TO 1000
  38. WRITE(MESS(ILON+1:ILON+15),FMT='(1PG12.5)')XPO
  39. ILON=ILON+16
  40. ELSEIF ((ICAR.EQ.'MOT ').OR.(ICAR.EQ.'PROCEDUR')) THEN
  41. CALL LIRCHA(ICARB,0,IRETOU)
  42. IF(IRETOU.EQ.0) THEN
  43. CALL ERREUR(5)
  44. RETURN
  45. ENDIF
  46. IFI=MIN(IRETOU,500)
  47. IF(ILON+IFI.GT.500) GO TO 1000
  48. MESS(ILON+1:ILON+IFI)=ICARB(1:IFI)
  49. ILON=ILON+IFI
  50. ELSEIF( ICAR.EQ.'TEXTE ') THEN
  51. CALL LIROBJ('TEXTE ',IPO,0,IRETOU)
  52. IF(IRETOU.EQ.0) THEN
  53. CALL ERREUR(5)
  54. RETURN
  55. ENDIF
  56. MTEXTE = IPO
  57. SEGACT MTEXTE
  58. IF(ILON+NCART.GT.500) GO TO 1000
  59. MESS(ILON+1:ILON+NCART)=MTEXT(1:NCART)
  60. ILON=ILON+NCART
  61. SEGDES MTEXTE
  62. ELSE
  63. CALL ERREUR (21)
  64. RETURN
  65. ENDIF
  66. GO TO 1
  67. 10 CONTINUE
  68. INTEXT = 0
  69. ILON=LONG(MESS(1:ILON))
  70. c DO 12 J=1,MIN(ILON,500-132),133
  71. c write(6,*) 'ligne',J,MIN(J+132,ILON)
  72. c WRITE(IOIMP,11) MESS (J:MIN(J+132,ILON))
  73. WRITE(IOIMP,11) MESS (1:ILON)
  74. 11 FORMAT(1X,A)
  75. c 12 CONTINUE
  76. RETURN
  77. 1000 CONTINUE
  78. CALL ERREUR(274)
  79. RETURN
  80. END
  81.  
  82.  
  83.  
  84.  

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