Télécharger trbac.eso

Retour à la liste

Numérotation des lignes :

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

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