Télécharger la plaquette Cast3M


fr en

Télécharger trbac1.eso

Retour à la liste

Numérotation des lignes : 

trbac1

  1. C TRBAC1    SOURCE    CB215821  24/07/17    21:15:19     11961          
  2.       SUBROUTINE TRBAC1(MTTE)
  3.       IMPLICIT INTEGER(I-N)
  4.  
  5. -INC PPARAM
  6. -INC CCOPTIO
  7. -INC SMBLOC
  8. -INC CCNOYAU
  9. -INC CCASSIS
  10.  
  11.       SEGMENT MTTE
  12.          CHARACTER*(LOCHAI) PHRA
  13.          CHARACTER*72       TRA
  14.          CHARACTER*(LONOM)  NOM
  15.          INTEGER INDI
  16.       ENDSEGMENT
  17.  
  18.       SEGACT MTTE*MOD
  19.       INDI = 1
  20.       PHRA = ' '
  21.       if(nbesc.ne.0) segact ipiloc
  22.       DO 103 I=1,NBNOM
  23.         IP= INOOB1(ITANO1(I))
  24.         IDEBCH = IPCHAR(IP)
  25.         IFINCH= IPCHAR( IP+1)-1
  26.         NOM=ICHARA(IDEBCH:IFINCH)
  27.         IF(NOM(1:1).NE.'#') THEN
  28.            IK=IFINCH-IDEBCH+1
  29.            PHRA(INDI:INDI+IK-1)=NOM(1:IK)
  30.            INDI=INDI+IK
  31.            IF(ITANOM(I).NE.' ') THEN
  32.               PHRA(INDI:INDI)='*'
  33.               INDI=INDI+1
  34.               PHRA(INDI:INDI+7)=ITANOM(I)
  35.               INDI=INDI+8
  36.            ELSE
  37.               INDI=INDI+1
  38.            ENDIF
  39.         ENDIF
  40. 103   CONTINUE
  41.  
  42.       IF(INDI.NE.1) THEN
  43.          PHRA (INDI:INDI)=  '='
  44.          INDI=INDI+2
  45.       ENDIF
  46.  
  47.       DO 104 I=1,IPVINT
  48.         IPLAC=ITINTE(I)
  49.         IF(IPLAC.LE.0) GO TO 104
  50.         IP= INOOB1(IPLAC)
  51.         IDEBCH = IPCHAR(IP)
  52.         IFINCH= IPCHAR(IP+1)-1
  53.         NOM=ICHARA(IDEBCH:IFINCH)
  54.         IPO=IOUEP2(IPLAC)
  55.  
  56.         IF(NOM.NE.' ') THEN
  57.            IK= IFINCH-IDEBCH+1
  58.            PHRA(INDI:INDI+IK-1)=NOM (1:IK)
  59.            INDI=INDI+IK+1
  60.         ELSE
  61.            IF(INOOB2(IPLAC).EQ.'ENTIER  ') THEN
  62.              TRA(1:10)=' '
  63.              WRITE(TRA,FMT='(I10)') IPO
  64.              IK=1
  65.              DO 1034 K=1,10
  66.              IF(TRA(K:K).NE.' ') THEN
  67.                 IK=K
  68.                 GO TO 1035
  69.              ENDIF
  70.  1034        CONTINUE
  71.  1035        CONTINUE
  72.              PHRA(INDI:INDI+10-IK)=TRA(IK:10)
  73.              INDI=INDI + 12 - IK
  74.  
  75.            ELSEIF(INOOB2(IPLAC).EQ.'FLOTTANT')THEN
  76.              WRITE(TRA,FMT='(G15.8)')XIFLOT(IPO)
  77.              DO 1036 K=1,15
  78.              IF(TRA(K:K).NE.' ') THEN
  79.                 IK=K
  80.                 GO TO 1037
  81.              ENDIF
  82.  1036        CONTINUE
  83.  1037        CONTINUE
  84.              IKK=IK
  85.              DO 1038 K=15,IK,-1
  86.              IF(TRA(K:K).NE.'0'.AND.TRA(K:K).NE.' ') THEN
  87.                 IKK=K
  88.                 GO TO 1039
  89.              ENDIF
  90.  1038        CONTINUE
  91.  1039        CONTINUE
  92.              PHRA(INDI:INDI+IKK-IK)=TRA(IK:IKK)
  93.              INDI=INDI + IKK - IK +2
  94.  
  95.            ELSEIF(INOOB2(IPLAC).EQ.'MOT     ')THEN
  96.              JF=IPCHAR(IPO+1)
  97.              ID=IPCHAR(IPO)
  98.              ILO=JF-ID
  99.              PHRA(INDI+1:INDI+ILO)=ICHARA(ID:JF-1)
  100.              INDI=INDI + ILO + 2
  101.            ENDIF
  102.         ENDIF
  103. 104   CONTINUE
  104.       if(nbesc.ne.0) SEGDES,IPILOC
  105.       INDI = INDI -1
  106.       RETURN
  107.       END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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