1 : C NTATAB SOURCE GOUNAND 14/01/29 21:15:14 7923 2 : C AFFECTE UN ELEMENT D'UNE TABLE. APPELE PAR LIRNOM 3 : C 4 : SUBROUTINE NTATAB(INOM,IBTYP,IRET,ISUCC) 5 : C ITAB POINTEUR SUR LA TABLE 6 : C INDIC1 TYPE DE L'INDICE 7 : C INDIC2 RANG DANS PILE DE L'INDICE 8 : C IBTYP TYPE DE L'ELEMENT 9 : C IRET VALEUR DE L'ELEMENT 10 : C DIMENSION IBTYP(2) 11 : IMPLICIT INTEGER(I-N) 12 : -INC CCNOYAU 13 : -INC CCOPTIO 14 : -INC SMTABLE 15 : -INC SMBLOC 16 : -INC CCASSIS 17 : REAL*8 XIFTMP 18 : CHARACTER*(*)IBTYP 19 : CHARACTER*(8)ITBNO 20 : *sg CHARACTER*72 CHARIN 21 : CHARACTER*512 CHARIN 22 : EXTERNAL LONG 23 : IMETH=ISUCC 24 : ISUCC=0 25 : * write(6,*) ' entree dans ntatab isucc',imeth 26 : ITBNOM=ITANO1(INOM) 27 : MTABLE=IOUEP2(ITBNOM) 28 : IF(IMETH.EQ.1) THEN 29 : IF (MOBJCO.NE.0) THEN 30 : MTABLE=MOBJCO 31 : ELSE 31 : CALL ERREUR(863) 32 : RETURN 33 : ENDIF 34 : ELSE 35 : INDIC1=ITANO1(INOM+1) 36 : ITBNO=INOOB2(INDIC1) 37 : IF(ITBNO.NE.'SEPARATE') RETURN 38 : ENDIF 39 : ISUCC=1 40 : INOM=INOM+2-IMETH 41 : INDIC2=ITANO1(INOM) 42 : ITBNO=INOOB2(INDIC2) 43 : INDIC2=IOUEP2(INDIC2) 44 : SEGACT MTABLE*MOD 45 : 10 CONTINUE 46 : * RECHERCHE DE LA POSITION CORRESPONDANTE DE LA TABLE 47 : NTDIM= MLOTAB 48 : IF(NTDIM.EQ.0) GO TO 21 49 : if(nbesc.ne.0) segact ipiloc 50 : XIFTMP=0 51 : IF (ITBNO.EQ.'FLOTTANT') XIFTMP=XIFLOT(INDIC2) 52 : DO 20 I=1,NTDIM 53 : IF (MTABTI(I).NE.ITBNO) GOTO 20 54 : IF (ITBNO.EQ.'FLOTTANT') THEN 55 : IF (RMTABI(I).NE.XIFTMP) GOTO 20 56 : ELSEIF(ITBNO.EQ.'MOT ')THEN 57 : C ON VA COMPARER LES MOTS SANS TENIR COMPTE DES BLANCS DE LA FIN 58 : IOD=IPCHAR(INDIC2) 59 : IOF=IPCHAR(INDIC2+1) 60 : L2= LONG(ICHARA(IOD:IOF-1))+IOD-1 61 : IP=MTABII(I) 62 : ID=IPCHAR(IP) 63 : IFI=IPCHAR(IP+1) 64 : L1=LONG(ICHARA(ID:IFI-1))+ID-1 65 : IF(ICHARA(IOD:L2).NE.ICHARA(ID:L1))GO TO 20 66 : ELSE 67 : IF (MTABII(I).NE.INDIC2) GOTO 20 68 : ENDIF 69 : * REMPLACEMENT DANS LE CAS OU IL NE S'AGIT PAS D'UNE TABLE 70 : * SINON RENVOI EN 10 AVEC LA NOUVELLE TABLE 71 : IF(MTABTV(I).EQ.'TABLE ') THEN 72 : MTAB1 = MTABIV(I) 73 : IF((INOM+1).GT.NBNOM) GO TO 11 74 : INDIC1=ITANO1(INOM + 1) 75 : ITBNO=INOOB2(INDIC1) 76 : IF(ITBNO.EQ.'SEPARATE') THEN 77 : * IL NE S'AGISSAIT PAS REELEMENT D'UN REMPLACEMENT 78 : INOM=INOM+2 79 : IF(INOM.GT.NBNOM) THEN 79 : CALL ERREUR(314) 80 : if ( nbesc.ne.0) segdes ipiloc 81 : RETURN 82 : ENDIF 83 : INDIC2=ITANO1(INOM) 84 : ITBNO=INOOB2(INDIC2) 85 : INDIC2=IOUEP2(INDIC2) 86 : SEGDES MTABLE 87 : MTABLE=MTAB1 88 : SEGACT MTABLE*MOD 89 : GO TO 10 90 : ENDIF 91 : ENDIF 92 : 11 CONTINUE 93 : MTABTV(I)= IBTYP 94 : IF (IBTYP.NE.'FLOTTANT') THEN 95 : MTABIV(I)= IRET 96 : ELSE 97 : RMTABV(I)=XIFLOT(IRET) 98 : ENDIF 99 : SEGDES MTABLE 100 : if(nbesc.ne.0) segdes ipiloc 101 : RETURN 102 : 20 CONTINUE 103 : if(nbesc.ne.0) segdes ipiloc 104 : 21 CONTINUE 105 : MLOTAB=NTDIM+1 106 : M=MTABII(/1) 107 : IF (MLOTAB.GT.M) THEN 108 : M=M+50 109 : SEGADJ MTABLE 110 : ENDIF 111 : M=MLOTAB 112 : * ON AJOUTE A LA TABLE 113 : MTABTI(M)=ITBNO 114 : IF(' '.EQ.ITBNO) THEN 114 : CALL ERREUR (600) 115 : RETURN 116 : ENDIF 117 : if(nbesc.ne.0) segact ipiloc 118 : IF (ITBNO .EQ.'FLOTTANT') THEN 119 : RMTABI(M)=XIFLOT(INDIC2) 120 : ELSEIF(ITBNO .EQ.'MOT ') THEN 121 : C si l'indice est un mot on ne garde pas les blancs a la fin du mot 122 : IOD=IPCHAR(INDIC2) 123 : IOF=IPCHAR(INDIC2+1) 124 : L2= LONG(ICHARA(IOD:IOF-1)) 125 : *sg attention si L2> len(charin) 126 : L2=MIN(L2,LEN(CHARIN)) 127 : CHARIN(1:L2)=ICHARA(IOD:L2+IOD-1) 127 : CALL POSCHA(CHARIN(1:L2),IRET2) 128 : if(nbesc.ne.0) segact ipiloc 129 : MTABII(M)=IRET2 130 : ELSE 131 : MTABII(M)=INDIC2 132 : ENDIF 133 : MTABTV(M)=IBTYP 134 : IF (IBTYP.NE.'FLOTTANT') THEN 135 : MTABIV(M)=IRET 136 : ELSE 137 : RMTABV(M)=XIFLOT(IRET) 138 : ENDIF 139 : if(nbesc.ne.0) segdes ipiloc 140 : SEGDES MTABLE 141 : RETURN 142 : END 143 : 144 :
© Cast3M 2003 - All rights reserved.
Disclaimer