1 : C ECCTAB SOURCE CHAT 06/03/16 21:17:04 5336 2 : SUBROUTINE ECCTAB(MTABLE,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN, 3 : $ TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 4 : C 5 : C **** MET UN OBJET DANS UNE TABLE 6 : C **** TAPIND TYPE DE L'INDICE CHARACTER*(*) 7 : C **** PUIS LA VALEUR DE L'INDICE IVALIN SI ENTIER 8 : C **** XVALIN SI FLOTTANT 9 : C **** CHARIN SI MOT 10 : C **** LOGIN SI LOGIQUE 11 : C **** IOBIN POUR TOUT AUTRE TYPE 12 : C **** TAPOBJ TYPE DE L'OBJET CHARACTER*(*) 13 : C **** PUIS LA VALEUR DE L'INDICE IVALRE SI ENTIER 14 : C **** XVALRE SI FLOTTANT 15 : C **** CHARRE SI MOT 16 : C **** LOGRE SI LOGIQUE 17 : C **** IOBRE POUR TOUT AUTRE TYPE 18 : C **** 19 : C 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : -INC CCNOYAU 23 : -INC SMTABLE 24 : -INC CCOPTIO 25 : -INC CCASSIS 26 : external long 27 : REAL*8 XVALIN,XVALRE 28 : LOGICAL LOGRE,LOGIN 29 : CHARACTER*(*) TAPIND,TAPOBJ,CHARIN,CHARRE 30 : CHARACTER*(8) CHARA,TYPIND,TYPOBJ 31 : if(nbesc.ne.0) segact ipiloc 32 : TYPIND=TAPIND 33 : TYPOBJ=TAPOBJ 34 : SEGACT MTABLE*MOD 35 : IN = MLOTAB 36 : C 37 : C ***** RECHERCHE DE L'INDICE S'IL EXISTE 38 : C 39 : IA=4 40 : IF(TYPIND.EQ.'ENTIER ') IA=1 41 : IF(TYPIND.EQ.'FLOTTANT') IA=2 42 : IF(TYPIND.EQ.'MOT ') IA=3 43 : IF(TYPIND.EQ.'METHODE ') IA=3 44 : IF(TYPIND.EQ.'LOGIQUE ') IA=5 45 : C ****** dans le cas des mots on ignore les blancs situes a la fin 46 : IF(IA.EQ.3) IL=LONG(CHARIN) 47 : IF(IN.EQ.0) GO TO 10 48 : DO 1 I=1,IN 49 : MT=I 50 : IF(MTABTI(I).NE.TYPIND ) GO TO 1 51 : GO TO (11,12,13,14,15),IA 52 : 11 CONTINUE 53 : IF(MTABII(I).NE.IVALIN) GO TO 1 54 : GOTO 20 55 : 12 CONTINUE 56 : IF(RMTABI(I).NE.XVALIN ) GO TO 1 57 : GO TO 20 58 : 15 CONTINUE 59 : IF(IPLOGI(MTABII(I)).NEQV.LOGIN ) GO TO 1 60 : GO TO 20 61 : 14 CONTINUE 62 : IF(MTABII(I).NE.IOBIN) GO TO 1 63 : GOTO 20 64 : 13 CONTINUE 65 : IP=MTABII(I) 66 : ID=IPCHAR(IP) 67 : IFI=IPCHAR(IP+1) 68 : IL1=LONG(ICHARA(ID:IFI-1)) 69 : IF(IL1.NE.IL) GO TO 1 70 : IF(CHARIN(1:IL).NE.ICHARA(ID:ID+IL-1)) GO TO 1 71 : GO TO 20 72 : 1 CONTINUE 73 : 10 CONTINUE 74 : C 75 : C ***** L'INDICE N'EXISTE PAS ON L'AJOUTE 76 : C 77 : MLOTAB=MLOTAB+1 78 : M=MTABII(/1) 79 : IF (M.LT.MLOTAB) THEN 80 : M=M+50 81 : SEGADJ MTABLE 82 : ENDIF 83 : M=MLOTAB 84 : MT=M 85 : MTABTI(M)=TYPIND 86 : IF(IA.EQ.1) THEN 87 : IRET=IVALIN 88 : ELSEIF(IA.EQ.2) THEN 89 : RMTABI(MT)=XVALIN 90 : GO TO 20 91 : ELSEIF(IA.EQ.3) THEN 91 : CALL POSCHA( CHARIN(1:IL),IRET) 92 : GO TO 200 93 : ELSEIF(IA.EQ.5) THEN 93 : call poslog(login,iret) 94 : GO TO 200 95 : ELSEIF(IA.EQ.4) THEN 96 : IRET=IOBIN 97 : ENDIF 98 : 200 MTABII(MT)=IRET 99 : * if(nbesc.ne.0) segact ipiloc 100 : 20 CONTINUE 101 : 102 : C 103 : C ***** FINI POUR L'INDICE FAIRE LA VALEUR 104 : C 105 : IA=4 106 : IF(TYPOBJ.EQ.'ENTIER ') IA=1 107 : IF(TYPOBJ.EQ.'FLOTTANT') IA=2 108 : IF(TYPOBJ.EQ.'MOT ') IA=3 109 : IF(TYPOBJ.EQ.'LOGIQUE ') IA=5 110 : IF(IA.EQ.3) IL=LEN(CHARRE) 111 : MTABTV(MT)= TYPOBJ 112 : IF(IA.EQ.1) THEN 113 : IRET=IVALRE 114 : ELSEIF(IA.EQ.2) THEN 115 : IRET=0 116 : RMTABV(MT)=XVALRE 117 : GO TO 300 118 : ELSEIF(IA.EQ.3) THEN 118 : CALL POSCHA(CHARRE,IRET) 119 : GO TO 300 120 : ELSEIF(IA.EQ.5) THEN 120 : call poslog(logre,iret) 121 : GO TO 300 122 : ELSEIF(IA.EQ.4) THEN 123 : IRET=IOBRE 124 : ENDIF 125 : 300 MTABIV(MT)=IRET 126 : SEGDES MTABLE 127 : If(nbesc.ne.0) segdes ipiloc 128 : RETURN 129 : END 130 :
© Cast3M 2003 - All rights reserved.
Disclaimer