Télécharger nomtex.eso

Retour à la liste

Numérotation des lignes :

  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. 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
  19. CALL LIROBJ(CHAR,MTEXTE,1,IRETOU)
  20. IF(IERR.NE.0) GO TO 1010
  21. IMT=IMT+1
  22. SEGACT MTEXTE
  23. IF(ILON+NCART.GT.72) GO TO 1000
  24. MESS(ILON+1:ILON+NCART)=MTEXT(1:NCART)
  25. ILON=ILON+NCART+1
  26. SEGDES MTEXTE
  27. GO TO 1
  28. 3 IF(CHAR.NE.'ENTIER ') GO TO 4
  29. CALL LIRENT(IPO,1,IRETOU)
  30. IF(IERR.NE.0) GO TO 1010
  31. IF(ILON+13.GT.72) GO TO 1000
  32. IF(ABS(IPO).LT.10000) THEN
  33. WRITE(MESS(ILON+1:ILON+7),FMT='(I5)') IPO
  34. ILON=ILON+8
  35. ELSE
  36. WRITE(MESS(ILON+1:ILON+11),FMT='(I9)') IPO
  37. ILON=ILON+12
  38. ENDIF
  39. GO TO 1
  40. 4 IF(CHAR.NE.'FLOTTANT')GO TO 5
  41. CALL LIRREE(XPO,1,IRETOU)
  42. IF(IERR.NE.0) GO TO 1010
  43. IF( ILON +17.GT.72) GO TO 1000
  44. WRITE(MESS(ILON+1:ILON+15),FMT='(E13.6)')XPO
  45. ILON=ILON+16
  46. GO TO 1
  47. 5 IF ((CHAR.NE.'MOT ').AND.(CHAR.NE.'PROCEDUR')) GO TO 6
  48. CALL LIRCHA(ICARB,1,IRETOU)
  49. IF(IERR.NE.0) GOTO 1010
  50. DO 25 IFI=72,1,-1
  51. IF(ICARB(IFI:IFI).EQ.' ') GO TO 25
  52. NCA=IFI
  53. GO TO 26
  54. 25 CONTINUE
  55. NCA = 1
  56. 26 CONTINUE
  57. IF(ILON+NCA.GT.72) GO TO 1000
  58. MESS(ILON+1:ILON+NCA)=ICARB(1:NCA)
  59. ILON=ILON+NCA+1
  60. GO TO 1
  61. 6 CALL REFUS
  62. 10 CONTINUE
  63. IF(IMT.EQ.0.AND.IPP.EQ.0) THEN
  64. CALL ERREUR ( 533)
  65. ELSE
  66. SEGINI MTEXTE
  67. NCART=ILON
  68. MTRADC=0
  69. ILL = MAX(1,ILON)
  70. MTEXT(1:ILL)=MESS(1:ILL)
  71. SEGDES MTEXTE
  72. CALL ECROBJ('TEXTE ',MTEXTE)
  73. IF(IIMPI.EQ.1756) WRITE(IOIMP,155) MTEXTE
  74. 155 FORMAT( ' DANS NOMTEX SEGMENT NUMERO : ',I5)
  75. ENDIF
  76. RETURN
  77. 1000 CONTINUE
  78. CALL ERREUR(425)
  79. RETURN
  80. 1010 CONTINUE
  81. CALL ERREUR (5)
  82. RETURN
  83. END
  84.  
  85.  
  86.  

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