1 : C HERITE SOURCE CHAT 06/03/16 21:18:20 5336 2 : SUBROUTINE HERITE 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCOPTIO 5 : -INC SMBLOC 6 : -INC CCNOYAU 7 : -INC SMTABLE 7 : CALL LIROBJ('OBJET ',MTABLE,1,IRETOU) 8 : IF(IERR.NE.0) RETURN 8 : CALL LIROBJ('OBJET ',MTAB1,0,IRETOU) 9 : if( iretou.eq.0) then 10 : IF(MOBJCO.NE.0) THEN 11 : MTAB1=MTABLE 12 : MTABLE=MOBJCO 13 : ELSE 14 : MOTERR(1:8)='OBJET ' 14 : CALL ERREUR(37) 15 : ENDIF 16 : ENDIF 17 : IF(IERR.NE.0) RETURN 18 : SEGACT MTAB1 19 : SEGACT MTABLE*MOD 20 : IN=MTAB1.MLOTAB 21 : DO 1 I =1,IN 22 : IF( MTAB1.MTABTV(I) .NE.'PROCEDUR') GO TO 1 23 : IF( MTAB1.MTABTI(I) .NE.'METHODE ') GO TO 1 24 : IOBJ = MTAB1.MTABIV(I) 25 : IMET = MTAB1.MTABII(I) 26 : DO 2 K=1,MLOTAB 27 : IF(MTABII(K).NE.IMET) GO TO 2 28 : IF(MTABTI(K).NE.'METHODE ') GO TO 2 29 : * l'indice existe on remplace 30 : MTABIV(K)=IOBJ 31 : MTABTV(K)='PROCEDUR' 32 : GO TO 1 33 : 2 CONTINUE 34 : * l'indice n'existe pas on l'ajoute 35 : M = MTABII(/1) 36 : IF(M.EQ.MLOTAB) THEN 37 : M = M + 20 38 : SEGADJ MTABLE 39 : ENDIF 40 : MLOTAB=MLOTAB+1 41 : MTABII(MLOTAB) = IMET 42 : MTABIV(MLOTAB) = IOBJ 43 : MTABTI(MLOTAB)='METHODE ' 44 : MTABTV(MLOTAB) = 'PROCEDUR' 45 : 1 CONTINUE 46 : SEGDES MTAB1,MTABLE 47 : RETURN 48 : END 49 :
© Cast3M 2003 - All rights reserved.
Disclaimer