Télécharger la plaquette Cast3M


fr en

Télécharger tradte.eso

Retour à la liste

Numérotation des lignes : 

tradte

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

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