1 : C PRENOM SOURCE CHAT 11/05/04 21:17:50 6963 2 : SUBROUTINE PRENOM(IPLAMO,IAVA,JREDLE) 3 : C 4 : C SERT A RETOURNER LA PLACE DE MOT DANS LA TABLE DES OBJETS. 5 : C CELA A PARTIR DE MDEOBJ (DEBUT DE LA PILE OBJET AFFECTEE A LA 6 : C PROCEDURE . SI LE MOT EXISTAIT AVANT MDEOBJ IL INITIALISE LE 7 : C NOUVEAU EGAL AU DERNIER CREE ( SAUF POUR LE CAS DES BLOCS). 8 : C SI CE MOT N'EXISTE PAS ON LE MET EN DERNIER ET ON LUI AFFECTE 9 : C LE TYPE MOT . 10 : C CAS D'UNE CONSTANTE : (IRE=1 ENTIER;IRE=2 FLOTTANT;IRE=5 BOOLEEN 11 : C IDEM PRECEDEMENT DANS LA TABLE DES NOMS LE NOM EST BLANC 12 : C CAS D'UN TEXTE : IRE=4 ON LE STOCKE COMME UN OBJET MAIS 13 : C ON LUI ATTRIBUE UN SEGMENT ET ON STOCKE LE POINTEUR DANS LA TABLE 14 : C DES OBJETS. 15 : C CAS D'UN SEPARATEUR : (IRE = 6) ON TRAITE COMME UN MOT 16 : C IAVA=1 ON EST AVANT LE SIGNE =, ONINITIALISE PAS LA VALEUR AVEC 17 : C LES OBJETS DEFINIES AVANT LA PROCEDURE 18 : C 19 : C IAVA=0 ON EST APRES LE SIGNE =, ON INITIALISE LE TYPE ET LA VALEUR 20 : C 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : -INC CCOPTIO 25 : -INC CCNOYAU 26 : -INC CCREDLE 27 : -INC SMTEXTE 28 : -INC SMBLOC 29 : -INC CCASSIS 30 : CHARACTER*(8) MOBLO 31 : CHARACTER*72 MOTBUF 32 : SAVE INSEPA,INMETH 33 : DATA MOBLO/'BLOC '/ 34 : DATA INSEPA/0/,INMETH/0/ 35 : LOGICAL BOOLIR 36 : SREDLE=JREDLE 37 : IPLAMO=0 38 : ILON=INOOB1(/1) 39 : * If(insepa.eq.0) then 39 : * CALL POSCHA('.',INCHA) 40 : * LMNNOM=LMNNOM+1 41 : ** INSEPA=LMNNOM 42 : * INOOB2(LMNNOM)='SEPARATE' 43 : * INOOB1(LMNNOM)=INCHA 44 : * IOUEP2(LMNNOM)= INCHA 45 : * ENDIF 46 : 100 continue 47 : * if(ire.eq.7) write(6,*) ' ire inmeth ' , ire , inmeth 48 : * IF(IRE.EQ.7.AND.INMETH.NE.0) THEN 49 : * IPLAMO=INMETH 50 : * RETURN 51 : * ENDIF 52 : * write(6,*) ' sredle ire ', sredle,ire 53 : IF(IRE.EQ.7)THEN 54 : IF(INMETH.EQ.0) THEN 54 : CALL POSCHA('%',INCHA) 55 : LMNNOM=LMNNOM+1 56 : IF( LMNNOM.GT.ILON) THEN 57 : N=LMNNOM+50 58 : SEGADJ ITABOB,ITABOC,ITABOD 59 : ENDIF 60 : INMETH=LMNNOM 61 : INOOB2(LMNNOM)='METHODOL' 62 : INOOB1(LMNNOM)=INCHA 63 : IOUEP2(LMNNOM)= INCHA 64 : iplamo=lmnnom 65 : ENDIF 66 : IPLAMO=INMETH 67 : RETURN 68 : ENDIF 69 : IF(IRE.EQ.6)THEN 70 : IF(INSEPA.EQ.0) THEN 70 : CALL POSCHA('.',INCHA) 71 : LMNNOM=LMNNOM+1 72 : IF( LMNNOM.GT.ILON) THEN 73 : N=LMNNOM+50 74 : SEGADJ ITABOB,ITABOC,ITABOD 75 : ENDIF 76 : INSEPA=LMNNOM 77 : INOOB2(LMNNOM)='SEPARATE' 78 : INOOB1(LMNNOM)=INCHA 79 : IOUEP2(LMNNOM)= INCHA 80 : iplamo=lmnnom 81 : ENDIF 82 : IPLAMO=INSEPA 83 : RETURN 84 : ENDIF 85 : IF(IRE.NE.3.AND.IRE.NE.4) GO TO 30 86 : MOTBUF(1:NCAR)=MOT(1:NCAR) 87 : NCAS=NCAR 87 : CALL POSCHA(MOTBUF(1:NCAS),INCHA) 88 : 96 CONTINUE 89 : C 90 : C la chaine est en incha ieme position dans la pile des chaines 91 : C 92 : IF(IRE.EQ.3.AND.NCAR.LT.9) THEN 93 : MAA = MDEOBJ 94 : IF(MFIOBJ.NE.0) MAA = 1 95 : DO 1 J =LMNNOM,MAA,-1 96 : IF(INCHA.NE.INOOB1(J)) GOTO 1 97 : IPLAMO = J 98 : return 99 : 1 CONTINUE 100 : ELSE 101 : DO 72 J=LMNNOM,MDEOBJ,-1 102 : IF(INOOB1(J).NE.1) GO TO 72 103 : IF(INOOB2(J).NE.'MOT ') GO TO 72 104 : IF(IOUEP2(J).NE.INCHA) GO TO 72 105 : IPLAMO=J 106 : * if(ire.eq.7)write(6,*) 'on a trouve la methodol ',iplamo,INOOB2(J) 107 : RETURN 108 : 72 CONTINUE 109 : ENDIF 110 : 98 CONTINUE 111 : LMNNOM=LMNNOM+1 112 : IPLAMO=LMNNOM 113 : IF( LMNNOM.GT.ILON) THEN 114 : N=LMNNOM+50 115 : SEGADJ ITABOB,ITABOC,ITABOD 116 : ENDIF 117 : INOOB1(LMNNOM)=INCHA 118 : IF(IRE.EQ.4) INOOB1(LMNNOM)=1 119 : * 120 : * CORRECTION PV UN MOT DE PLUS DE 8 CARACTERES NE PEUT PAS ETRE 121 : * UN NOM 122 : IF (NCAR.GT.8) INOOB1(LMNNOM)=1 123 : * 124 : INOOB2(LMNNOM)='MOT' 125 : IOUEP2(LMNNOM)= INCHA 126 : * IF(IRE.EQ.7) THEN 127 : * write(6,*) ' prenom creation d une methodol ',iplamo 128 : * INOOB2(LMNNOM)='METHODOL' 129 : * INMETH=IPLAMO 130 : * ENDIF 131 : RETURN 132 : 30 CONTINUE 133 : C 134 : C CAS DES AUTRES CHOSE QUE MOT 135 : C 136 : IF(IRE.EQ.1) THEN 137 : DO 1501 K=lmnnom,mdeobj,-1 138 : IF(IOUEP2(K).NE.NFIX) GO TO 1501 139 : IF(INOOB2(K).NE.'ENTIER ') GO TO 1501 140 : IF(INOOB1(K).NE.1) GO TO 1501 141 : IPLAMO=K 142 : RETURN 143 : 1501 CONTINUE 144 : LMNNOM=LMNNOM+1 145 : IF(LMNNOM.GT.INOOB1(/1)) THEN 146 : N = LMNNOM + 50 147 : SEGADJ ITABOB,ITABOC,ITABOD 148 : ENDIF 149 : N=LMNNOM 150 : INOOB1(N)=1 151 : INOOB2(N)='ENTIER ' 152 : IOUEP2(N)=NFIX 153 : IPLAMO=N 154 : RETURN 155 : ELSEIF(IRE.EQ.2) THEN 156 : if(nbesc.ne.0) segact ipiloc 157 : IO=XIFLOT(/1) 158 : if(nbesc.ne.0) segdes ipiloc 159 : xxfl= flot 159 : call posree(xxfl,j) 160 : IF(j.le.io) then 161 : DO 1503 K=MDEOBJ,LMNNOM 162 : IF(IOUEP2(K).NE.J) GO TO 1503 163 : IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503 164 : IF(INOOB1(K).NE.1) GO TO 1503 165 : IPLAMO=K 166 : RETURN 167 : 1503 CONTINUE 168 : endif 169 : IIP=J 170 : LMNNOM=LMNNOM+1 171 : IF(LMNNOM.GT.INOOB1(/1)) THEN 172 : N = LMNNOM+ 50 173 : SEGADJ ITABOB,ITABOC,ITABOD 174 : ENDIF 175 : N=LMNNOM 176 : INOOB1(N)=1 177 : INOOB2(N)='FLOTTANT' 178 : IOUEP2(N)=IIP 179 : IPLAMO=N 180 : RETURN 181 : ELSEIF (IRE.EQ.5) THEN 182 : * write(6,*) ' on traite un logique' , bool 183 : boolir=bool 183 : call poslog(boolir,j) 184 : * write(6,*) j , iouep2(13),inoob2(13), inoob1(13) 185 : DO 1505 K=1,LMNNOM 186 : IF(IOUEP2(K).NE.J) GO TO 1505 187 : IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505 188 : IF(INOOB1(K).NE.1) GO TO 1505 189 : IPLAMO=K 190 : * write(6,*) ' on a trouve un logique ioplamo ' , iplamo 191 : RETURN 192 : 1505 CONTINUE 193 : IIP=J 194 : LMNNOM=LMNNOM+1 195 : IF(LMNNOM.GT.INOOB1(/1)) THEN 196 : N=LMNNOM+50 197 : SEGADJ ITABOB,ITABOC,ITABOD 198 : ENDIF 199 : N=LMNNOM 200 : INOOB1(N)=1 201 : INOOB2(N)='LOGIQUE ' 202 : IOUEP2(N)=IIP 203 : IPLAMO=N 204 : RETURN 205 : ENDIF 206 : RETURN 207 : END 208 : 209 : 210 : 211 : 212 :
© Cast3M 2003 - All rights reserved.
Disclaimer