Télécharger tradte.eso

Retour à la liste

Numérotation des lignes :

  1. C TRADTE SOURCE CB215821 19/11/15 21:16:14 10378
  2. C TRADUITLE CONTENU D'UN OBJET DE TYPE TEXTE (MTE) ET RENVOI LE
  3. C POINTEUR SUR LE SEGMENT TRADUCTION
  4. SUBROUTINE TRADTE(MTE,MTRA)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. -INC CCREDLE
  8. -INC CCOPTIO
  9. -INC SMTEXTE
  10. -INC CCNOYAU
  11. -INC SMBLOC
  12. -INC CCASSIS
  13. CHARACTER*500 CMTEXT
  14. character*72 motbuf
  15. MTEXTE=MTE
  16. SEGACT MTEXTE*MOD
  17. if(iimpi.eq.1754) then
  18. write(6,*) ' traduction du texte : '
  19. write(6,*) mtext
  20. write(6,*) ' lmnnom ' , lmnnom
  21. endif
  22. mtradc=0
  23. IF(MTRADC.NE.0) THEN
  24. MTRA=MTRADC
  25. IF(IIMPI.EQ.1756)WRITE(IOIMP,4822) MTEXTE,MTRADC
  26. 4822 FORMAT (' TRADTE MTRADC.NE.0 : MTEXTE MTRADC ',2I5)
  27. SEGDES MTEXTE
  28. RETURN
  29. ENDIF
  30. *C-- ON SAUVE TEXT DE FACON A LE SURCHARGER TEMPORAIREMENT
  31. * CMTEXT(1:500)=TEXT(1:500)
  32. * NRAN1=NRAN
  33. * ICOUR1=ICOUR
  34. * IFINA1=IFINAN
  35. * IPREC1=IPREC
  36. *C-- ON PLACE L'OBJET DE TYPE TEXTE DANS TEXT
  37. call inired(sredle)
  38. TEXT(1:500)=MTEXT(1:NCART)
  39. NRAN= 0
  40. IPREC=1
  41. IFINAN=NCART
  42. ICOUR=NCART
  43. SEGINI MTRADU
  44. MTRADC=MTRADU
  45. MTRA=MTRADU
  46. 21 CONTINUE
  47. CALL REDLEC(sredle)
  48. C IRE = 0 FIN DE PHRASE
  49. C
  50. ifinpi=lmnnom
  51. IF (IRE.EQ.0) GO TO 300
  52. IF(IRE.NE.3.AND.IRE.NE.4.AND.IRE.NE.6) GO TO 30
  53. motbuf(1:ncar)=mot(1:ncar)
  54. ncas=ncar
  55. * write (6,*) ' dans tradte avant poscha ',ncar,motbuf(1:ncas)
  56. CALL POSCHA(MOTbuf(1:NCAs),INCHA)
  57. IF(IIMPI.EQ.1756) then
  58. write(6,*) ' apres poscha ' , incha
  59. endif
  60.  
  61. C
  62. C la chaine est en incha ieme position dans la pile des chaines
  63. C
  64.  
  65. IF(IRE.EQ.3.AND.NCAR.LT.9) THEN
  66. DO 1 J =ifinpi,1,-1
  67. IF(INCHA.NE.INOOB1(J)) GOTO 1
  68. * write(6,*) ' inoob2(j) ', inoob2(j)
  69. IPLAMO = J
  70.  
  71. GO TO 301
  72. 1 CONTINUE
  73. ELSEIF (IRE.EQ.6) THEN
  74. IF (INSEPA.GT.0) THEN
  75. IPLAMO=INSEPA
  76. GOTO 301
  77. ELSE
  78. GOTO 98
  79. ENDIF
  80. ELSE
  81. DO 72 J=ifinpi,1,-1
  82. IF(INOOB1(J).NE.1) GO TO 72
  83. IF(INOOB2(J).NE.'MOT') GO TO 72
  84. IF(IOUEP2(J).NE.INCHA) GO TO 72
  85. IPLAMO=J
  86. GO TO 301
  87. 72 CONTINUE
  88. ENDIF
  89. * on s'assure de ne pas pointer vers une procedure
  90. DO 430 J=ifinpi,1,-1
  91. IF(INCHA.NE.INOOB1(J))GO TO 430
  92. IF(INOOB2(J).EQ.'PROCEDUR') THEN
  93. IPLAMO=J
  94. GO TO 301
  95. ENDIF
  96. 430 CONTINUE
  97. 98 CONTINUE
  98. if(iimpi.eq.1756) then
  99. write(6,*) ' tradte on cree un nouveau nom '
  100. endif
  101. LMNNOM=LMNNOM+1
  102. IPLAMO=LMNNOM
  103. IF( LMNNOM.GT.IOUEP2(/1)) THEN
  104. N=LMNNOM+50
  105. SEGADJ ITABOB,ITABOC,ITABOD
  106. ENDIF
  107. INOOB1(LMNNOM)=INCHA
  108. IF(IRE.EQ.4) INOOB1(LMNNOM)=1
  109. *
  110. * CORRECTION PV UN MOT DE PLUS DE 8 CARACTERES NE PEUT PAS ETRE
  111. * UN NOM
  112. IF (NCAR.GT.8) INOOB1(LMNNOM)=1
  113. *
  114. INOOB2(LMNNOM)='MOT'
  115. IOUEP2(LMNNOM)= INCHA
  116. IF(IRE.EQ.6) THEN
  117. INOOB2(LMNNOM)='SEPARATE'
  118. INSEPA=IPLAMO
  119. ENDIF
  120. GO TO 301
  121. 30 CONTINUE
  122. C
  123. C CAS DES AUTRES CHOSE QUE MOT
  124. C
  125. IF(IRE.EQ.1) THEN
  126. DO 1501 K=ifinpi,1,-1
  127. IF(IOUEP2(K).NE.NFIX) GO TO 1501
  128. IF(INOOB2(K).NE.'ENTIER ') GO TO 1501
  129. IF(INOOB1(K).NE.1) GO TO 1501
  130. IPLAMO=K
  131. GO TO 301
  132. 1501 CONTINUE
  133. LMNNOM=LMNNOM+1
  134. IF(LMNNOM.GT.INOOB1(/1)) THEN
  135. N = LMNNOM + 50
  136. SEGADJ ITABOB,ITABOC,ITABOD
  137. ENDIF
  138. N=LMNNOM
  139. INOOB1(N)=1
  140. INOOB2(N)='ENTIER '
  141. IOUEP2(N)=NFIX
  142. IPLAMO=N
  143. GO TO 301
  144. ELSEIF(IRE.EQ.2) THEN
  145. if(nbesc.ne.0) segact ipiloc
  146. IO=XIFLOT(/1)
  147. if(nbesc.ne.0) SEGDES,IPILOC
  148. xtoto= flot
  149. call posree(xtoto,j)
  150. if(j.le.io) then
  151. DO 1503 K=ifinpi,1,-1
  152. IF(IOUEP2(K).NE.J) GO TO 1503
  153. IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503
  154. IF(INOOB1(K).NE.1) GO TO 1503
  155. IPLAMO=K
  156. GO TO 301
  157. 1503 CONTINUE
  158. endif
  159. IIP=J
  160. LMNNOM=LMNNOM+1
  161. IF(LMNNOM.GT.INOOB1(/1)) THEN
  162. N = LMNNOM+ 50
  163. SEGADJ ITABOB,ITABOC,ITABOD
  164. ENDIF
  165. N=LMNNOM
  166. INOOB1(N)=1
  167. INOOB2(N)='FLOTTANT'
  168. IOUEP2(N)=IIP
  169. IPLAMO=N
  170. GO TO 301
  171. ELSEIF (IRE.EQ.5) THEN
  172. if(nbesc.ne.0) segact ipiloc
  173. IO=IPLOGI(/1)
  174. if(nbesc.ne.0) SEGDES,IPILOC
  175. call poslog(bool,j)
  176. if(j.le.io) then
  177. DO 1505 K=ifinpi,1,-1
  178. IF(IOUEP2(K).NE.J) GO TO 1505
  179. IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505
  180. IF(INOOB1(K).NE.1) GO TO 1505
  181. IPLAMO=K
  182. GO TO 301
  183. 1505 CONTINUE
  184. endif
  185. IIP=J
  186. LMNNOM=LMNNOM+1
  187. IF(LMNNOM.GT.INOOB1(/1)) THEN
  188. N=LMNNOM+50
  189. SEGADJ ITABOB,ITABOC,ITABOD
  190. ENDIF
  191. N=LMNNOM
  192. INOOB1(N)=1
  193. INOOB2(N)='LOGIQUE '
  194. IOUEP2(N)=IIP
  195. IPLAMO=N
  196. ENDIF
  197. 301 CONTINUE
  198. MTRAD(**)=IPLAMO
  199. GO TO 21
  200. 300 CONTINUE
  201. MM=MTRAD(/1)
  202. IF(IIMPI.EQ.1756)WRITE(IOIMP,4821) MTEXTE,MTRADU,MM
  203. 4821 FORMAT (' CREATION DU TEXTE : MTEXTE MTRADU MTRAD(/1)',3I5)
  204. if(iimpi.eq.1754) then
  205. write(6,*) 'resultat dela precompilation : ' , mtrad(/1)
  206. write(6,*) ( mtrad(iou),iou=1,mtrad(/1))
  207. endif
  208. C-- ON REMET TEXT EN PLACE
  209. * TEXT(1:500)=CMTEXT(1:500)
  210. * IFINAN=IFINA1
  211. * IPREC=IPREC1
  212. * ICOUR=ICOUR1
  213. * NRAN=NRAN1
  214. segsup sredle
  215. SEGDES MTRADU
  216. SEGDES MTEXTE
  217. RETURN
  218. END
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  

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