Télécharger anabac.eso

Retour à la liste

Numérotation des lignes :

  1. C ANABAC SOURCE CHAT 06/03/29 21:15:24 5360
  2. SUBROUTINE ANABAC
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC SMBLOC
  6. -INC CCNOYAU
  7. -INC CCASSIS
  8. -INC SMLMOTS
  9. SEGMENT MTTE
  10. CHARACTER*600 PHRA
  11. CHARACTER*600 PHRH
  12. CHARACTER*72 TRA
  13. CHARACTER*8 NOM
  14. ENDSEGMENT
  15. IF ( .NOT. LODESL ) THEN
  16. IRR=IERR
  17. IERR=0
  18. CALL GINT2
  19. CALL ERREUR (-273)
  20. IERR=IRR
  21. CALL GINT2
  22. END IF
  23. SEGINI MTTE
  24. JNDI = 1
  25. PHRA = ' '
  26. PHRH = ' '
  27. if(nbesc.ne.0) segact ipiloc
  28. DO 104 I=1,ITINTE(/1)
  29. C WRITE(6,FMT='('' JNDI '',i5)') JNDI
  30. IPLAC=ITINTE(I)
  31. IF(IPLAC.LE.0) GO TO 118
  32. IP=INOOB1(IPLAC)
  33. IDEBCH = IPCHAR(IP)
  34. IFINCH=IPCHAR(IP+1)
  35. NOM = ICHARA(IDEBCH:IFINCH-1)
  36. IPO=IOUEP2(IPLAC)
  37. IK=IFINCH-IDEBCH
  38. IF(NOM.NE.' ') THEN
  39. PHRA(JNDI:JNDI+IK-1)=NOM(1:IK)
  40. NOM = INOOB2(IPLAC)
  41. DO 1042 K=8,1,-1
  42. IF(NOM(K:K).NE.' ') THEN
  43. IL=K
  44. GO TO 1043
  45. ENDIF
  46. 1042 CONTINUE
  47. 1043 CONTINUE
  48. PHRH(JNDI:JNDI+IL-1) = NOM
  49. C WRITE(6,FMT='( '' OBJET'',i4)') IK
  50. JNDI=JNDI + MAX( IK,IL) + 1
  51. IF (JNDI.GT.588 ) GO TO 118
  52. ELSE
  53. IF(INOOB2(IPLAC).EQ.'ENTIER ') THEN
  54. TRA(1:10)=' '
  55. WRITE(TRA,FMT='(I10)') IPO
  56. DO 1034 K=1,10
  57. IF(TRA(K:K).NE.' ') THEN
  58. IK=K
  59. GO TO 1035
  60. ENDIF
  61. 1034 CONTINUE
  62. 1035 CONTINUE
  63. PHRA(JNDI:JNDI+10-IK)=TRA(IK:10)
  64. PHRH(JNDI:JNDI+5 )='ENTIER'
  65. JNDI=JNDI + MAX ( 10 -IK,5) +2
  66. C WRITE(6,FMT='( '' ENTIER'',i4)') IK
  67. IF (JNDI.GT.588 ) GO TO 118
  68. ELSEIF(INOOB2(IPLAC).EQ.'FLOTTANT')THEN
  69. WRITE(TRA,FMT='(G15.8)')XIFLOT(IPO)
  70. DO 1036 K=1,15
  71. IF(TRA(K:K).NE.' ') THEN
  72. IK=K
  73. GO TO 1037
  74. ENDIF
  75. 1036 CONTINUE
  76. 1037 CONTINUE
  77. DO 1038 K=15,IK,-1
  78. IF(TRA(K:K).NE.'0'.AND.TRA(K:K).NE.' ') THEN
  79. IKK=K
  80. GO TO 1039
  81. ENDIF
  82. 1038 CONTINUE
  83. 1039 CONTINUE
  84. PHRA(JNDI:JNDI+IKK-IK)=TRA(IK:IKK)
  85. PHRH(JNDI:JNDI+7)='FLOTTANT'
  86. JNDI=JNDI + MAX(IKK-IK,7) + 2
  87. IK1= IKK -IK
  88. C WRITE(6,FMT='( '' FLOTTANT'',I4)') IK1
  89. IF (JNDI.GT.588 ) GO TO 118
  90. ELSEIF(INOOB2(IPLAC).EQ.'MOT ')THEN
  91. JF=IPCHAR(IPO+1)
  92. ID=IPCHAR(IPO)
  93. ILO=JF-ID
  94. PHRA(JNDI:JNDI+ILO-1)=ICHARA(ID:ID+ILO-1)
  95. PHRH(JNDI:JNDI+ 2 )='MOT'
  96. JNDI=JNDI + MAX(ILO,3) + 2
  97. C WRITE(6,FMT='( '' MOT '',I4)') ILO
  98. IF (JNDI.GT.588 ) GO TO 118
  99. ENDIF
  100. ENDIF
  101. 104 CONTINUE
  102. 118 CONTINUE
  103. if(nbesc.ne.0) segdes ipiloc
  104. JNDI = JNDI -1
  105. IF ( .NOT. LODESL ) THEN
  106. DO 3546 I=1,JNDI,72
  107. IJ = MIN( JNDI,I * 72)
  108. WRITE(6,355) PHRA(I:IJ)
  109. WRITE(6,355) PHRH(I:IJ)
  110. 355 FORMAT ( 1X,A)
  111. 3546 CONTINUE
  112. ELSE
  113. JGN = JNDI
  114. JGM = 2
  115. SEGINI MLMOTS
  116. MOTS(1)(1:JGN) = PHRA(1:JGN)
  117. MOTS(2)(1:JGN) = PHRH(1:JGN)
  118. SEGDES MLMOTS
  119. IPCAR1 = MLMOTS
  120. END IF
  121. SEGSUP MTTE
  122. RETURN
  123. END
  124.  
  125.  
  126.  

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