Télécharger trbac.eso

Retour à la liste

Numérotation des lignes :

  1. C TRBAC SOURCE CB215821 19/11/15 21:16:16 10378
  2. SUBROUTINE TRBAC
  3. IMPLICIT INTEGER(I-N)
  4.  
  5. -INC PPARAM
  6. -INC CCOPTIO
  7. -INC SMBLOC
  8. -INC CCNOYAU
  9. SEGMENT MTTE
  10. CHARACTER*600 PHRA
  11. CHARACTER*72 TRA
  12. CHARACTER*8 NOM
  13. INTEGER INDI
  14. ENDSEGMENT
  15. POINTEUR MTT1.MTTE
  16. CHARACTER*8 FORM
  17. SEGINI MTTE
  18. CALL TRBAC1(MTTE)
  19. MBCOAN= MBCOUR
  20. 1 CONTINUE
  21. IXE=0
  22. IYE=0
  23. IF(MBLSUP.NE.0) THEN
  24. DO 105 I=1,INDI
  25. IF ( PHRA (I:I).NE.'#') GO TO 105
  26. DO 106 K=I+1,INDI
  27. IF(PHRA(K:K).EQ. ' ') GO TO 107
  28. J=K
  29. 106 CONTINUE
  30. 107 J1=J-I
  31. TRA=' '
  32. TRA(1:2)='(I'
  33. WRITE(TRA(3:5),FMT='(I3)')J1
  34. TRA(6:6)=')'
  35. READ(PHRA(I+1:J),FMT=TRA,err=105) IYA
  36. IF(IYA.LT.IYE) GO TO 105
  37. IXE=I
  38. IXF=J
  39. IYE=IYA
  40. 105 CONTINUE
  41. IF(IXE.NE.0) THEN
  42. SEGINI MTT1
  43. MTXBLC=MTXBL
  44. if(mbcour.eq.0) mbcour = ninstv
  45. MBCOUR=MBCOUR-1
  46. NBNOMM=LMTXBM(MBCOUR+1)- LMTXBM(MBCOUR)
  47. IPVINT=MTXBA(MBCOUR+1)-MTXBA(MBCOUR)
  48. IDEF= LMTXBM(MBCOUR)
  49. DO 103 I=1,NBNOMM
  50. if( mtxblb(i+idef). ge . 0) then
  51. ITANO1(I)=MTXBLB(I+IDEF) +mdeobj -1
  52. else
  53. ITANO1(I)=MTXBLB(I+IDEF)/(-100)
  54. endif
  55. ITANOM(I)=MTXBLM(I+IDEF)
  56. C ITANO1(I)=MTXBLB(I)
  57. C ITANOM(I)=MTXBLM(I)
  58. 103 CONTINUE
  59. IDEF=MTXBA(MBCOUR)
  60. DO 104 I=1,IPVINT
  61. if( mtxbla(i+idef).gt.0) then
  62. ITINTE(I)=MTXBLA(I+IDEF) +mdeobj -1
  63. elseif(mtxbla(i+idef).lt.-99) then
  64. ITINTE(I)=MTXBLA(I+IDEF)/(-100)
  65. else
  66. ITINTE(I)=MTXBLA(I+IDEF)
  67. endif
  68. C ITINTE(I)=MTXBLA(I)
  69. 104 CONTINUE
  70. C SEGDES MTXBLL
  71. CALL TRBAC1(MTT1)
  72. PHRA(IXE:IXE)='('
  73. ILO = INDI-IXF
  74. IDD= IXE + MTT1.INDI+1
  75. IF(ILO.NE.0) THEN
  76. DO 108 K=ILO,1,-1
  77. PHRA(IDD+K:IDD+K)=PHRA(IXF+K:IXF+K)
  78. 108 CONTINUE
  79. ENDIF
  80. IND1=MTT1.INDI
  81. PHRA(IXE+1:IDD-1)= MTT1.PHRA(1:IND1)
  82. PHRA(IDD:IDD)=')'
  83. INDI=IDD+ILO+1
  84. SEGSUP MTT1
  85. GO TO 1
  86. ENDIF
  87. ENDIF
  88. MBCOUR=MBCOAN
  89. FORM = '(1X,A'
  90. IIA = MIN(INDI,72)
  91. WRITE(FORM(6:7),FMT='(I2)')IIA
  92. FORM(8:8)=')'
  93. WRITE(IOIMP,FMT=FORM) PHRA(1:INDI)
  94. SEGSUP MTTE
  95. RETURN
  96. END
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  

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