1 : C TRADTE SOURCE CHAT 11/07/28 21:15:08 7067 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 36 : call inired(sredle) 37 : TEXT(1:500)=MTEXT(1:NCART) 38 : NRAN= 0 39 : IPREC=1 40 : IFINAN=NCART 41 : ICOUR=NCART 42 : SEGINI MTRADU 43 : MTRADC=MTRADU 44 : MTRA=MTRADU 45 : 21 CONTINUE 45 : CALL REDLEC(sredle) 46 : C IRE = 0 FIN DE PHRASE 47 : C 48 : ifinpi=lmnnom 49 : IF (IRE.EQ.0) GO TO 300 50 : IF(IRE.NE.3.AND.IRE.NE.4.AND.IRE.NE.6) GO TO 30 51 : motbuf(1:ncar)=mot(1:ncar) 52 : ncas=ncar 53 : * write (6,*) ' dans tradte avant poscha ',ncar,motbuf(1:ncas) 53 : CALL POSCHA(MOTbuf(1:NCAs),INCHA) 54 : IF(IIMPI.EQ.1756) then 55 : write(6,*) ' apres poscha ' , incha 56 : endif 57 : 58 : C 59 : C la chaine est en incha ieme position dans la pile des chaines 60 : C 61 : 62 : IF(IRE.EQ.3.AND.NCAR.LT.9) THEN 63 : DO 1 J =ifinpi,1,-1 64 : IF(INCHA.NE.INOOB1(J)) GOTO 1 65 : * write(6,*) ' inoob2(j) ', inoob2(j) 66 : IPLAMO = J 67 : 68 : GO TO 301 69 : 1 CONTINUE 70 : ELSE 71 : DO 72 J=ifinpi,1,-1 72 : IF(INOOB1(J).NE.1) GO TO 72 73 : IF(INOOB2(J).NE.'MOT ') GO TO 72 74 : IF(IOUEP2(J).NE.INCHA) GO TO 72 75 : IPLAMO=J 76 : GO TO 301 77 : 72 CONTINUE 78 : ENDIF 79 : * on s'assure de ne pas pointer vers une procedure 80 : DO 430 J=ifinpi,1,-1 81 : IF(INCHA.NE.INOOB1(J))GO TO 430 82 : IF(INOOB2(J).EQ.'PROCEDUR') THEN 83 : IPLAMO=J 84 : GO TO 301 85 : ENDIF 86 : 430 CONTINUE 87 : 98 CONTINUE 88 : if(iimpi.eq.1756) then 89 : write(6,*) ' tradte on cree un nouveau nom ' 90 : endif 91 : LMNNOM=LMNNOM+1 92 : IPLAMO=LMNNOM 93 : IF( LMNNOM.GT.IOUEP2(/1)) THEN 94 : N=LMNNOM+50 95 : SEGADJ ITABOB,ITABOC,ITABOD 96 : ENDIF 97 : INOOB1(LMNNOM)=INCHA 98 : IF(IRE.EQ.4) INOOB1(LMNNOM)=1 99 : * 100 : * CORRECTION PV UN MOT DE PLUS DE 8 CARACTERES NE PEUT PAS ETRE 101 : * UN NOM 102 : IF (NCAR.GT.8) INOOB1(LMNNOM)=1 103 : * 104 : INOOB2(LMNNOM)='MOT' 105 : IOUEP2(LMNNOM)= INCHA 106 : IF(IRE.EQ.6) THEN 107 : INOOB2(LMNNOM)='SEPARATE' 108 : INSEPA=IPLAMO 109 : ENDIF 110 : GO TO 301 111 : 30 CONTINUE 112 : C 113 : C CAS DES AUTRES CHOSE QUE MOT 114 : C 115 : IF(IRE.EQ.1) THEN 116 : DO 1501 K=ifinpi,1,-1 117 : IF(IOUEP2(K).NE.NFIX) GO TO 1501 118 : IF(INOOB2(K).NE.'ENTIER ') GO TO 1501 119 : IF(INOOB1(K).NE.1) GO TO 1501 120 : IPLAMO=K 121 : GO TO 301 122 : 1501 CONTINUE 123 : LMNNOM=LMNNOM+1 124 : IF(LMNNOM.GT.INOOB1(/1)) THEN 125 : N = LMNNOM + 50 126 : SEGADJ ITABOB,ITABOC,ITABOD 127 : ENDIF 128 : N=LMNNOM 129 : INOOB1(N)=1 130 : INOOB2(N)='ENTIER ' 131 : IOUEP2(N)=NFIX 132 : IPLAMO=N 133 : GO TO 301 134 : ELSEIF(IRE.EQ.2) THEN 135 : if(nbesc.ne.0) segact ipiloc 136 : IO=XIFLOT(/1) 137 : if(nbesc.ne.0) segdes ipiloc 138 : xtoto= flot 138 : call posree(xtoto,j) 139 : if(j.le.io) then 140 : DO 1503 K=ifinpi,1,-1 141 : IF(IOUEP2(K).NE.J) GO TO 1503 142 : IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503 143 : IF(INOOB1(K).NE.1) GO TO 1503 144 : IPLAMO=K 145 : GO TO 301 146 : 1503 CONTINUE 147 : endif 148 : IIP=J 149 : LMNNOM=LMNNOM+1 150 : IF(LMNNOM.GT.INOOB1(/1)) THEN 151 : N = LMNNOM+ 50 152 : SEGADJ ITABOB,ITABOC,ITABOD 153 : ENDIF 154 : N=LMNNOM 155 : INOOB1(N)=1 156 : INOOB2(N)='FLOTTANT' 157 : IOUEP2(N)=IIP 158 : IPLAMO=N 159 : GO TO 301 160 : ELSEIF (IRE.EQ.5) THEN 161 : if(nbesc.ne.0) segact ipiloc 162 : IO=IPLOGI(/1) 163 : if(nbesc.ne.0) segdes ipiloc 163 : call poslog(bool,j) 164 : if(j.le.io) then 165 : DO 1505 K=ifinpi,1,-1 166 : IF(IOUEP2(K).NE.J) GO TO 1505 167 : IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505 168 : IF(INOOB1(K).NE.1) GO TO 1505 169 : IPLAMO=K 170 : GO TO 301 171 : 1505 CONTINUE 172 : endif 173 : IIP=J 174 : LMNNOM=LMNNOM+1 175 : IF(LMNNOM.GT.INOOB1(/1)) THEN 176 : N=LMNNOM+50 177 : SEGADJ ITABOB,ITABOC,ITABOD 178 : ENDIF 179 : N=LMNNOM 180 : INOOB1(N)=1 181 : INOOB2(N)='LOGIQUE ' 182 : IOUEP2(N)=IIP 183 : IPLAMO=N 184 : ENDIF 185 : 301 CONTINUE 186 : MTRAD(**)=IPLAMO 187 : GO TO 21 188 : 300 CONTINUE 189 : MM=MTRAD(/1) 190 : IF(IIMPI.EQ.1756)WRITE(IOIMP,4821) MTEXTE,MTRADU,MM 191 : 4821 FORMAT (' CREATION DU TEXTE : MTEXTE MTRADU MTRAD(/1)',3I5) 192 : if(iimpi.eq.1754) then 193 : write(6,*) 'resultat dela precompilation : ' , mtrad(/1) 194 : write(6,*) ( mtrad(iou),iou=1,mtrad(/1)) 195 : endif 196 : C-- ON REMET TEXT EN PLACE 197 : * TEXT(1:500)=CMTEXT(1:500) 198 : * IFINAN=IFINA1 199 : * IPREC=IPREC1 200 : * ICOUR=ICOUR1 201 : * NRAN=NRAN1 202 : segsup sredle 203 : SEGDES MTRADU 204 : SEGDES MTEXTE 205 : RETURN 206 : END 207 : 208 : 209 : 210 : 211 :
© Cast3M 2003 - All rights reserved.
Disclaimer