Télécharger la plaquette Cast3M


fr en

Télécharger nomtex.eso

Retour à la liste

Numérotation des lignes : 

nomtex

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

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