C HERITE SOURCE PV090527 24/01/09 21:15:10 11817 SUBROUTINE HERITE IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMBLOC -INC CCNOYAU -INC SMTABLE CALL LIROBJ('OBJET ',MTABLE,1,IRETOU) IF(IERR.NE.0) RETURN CALL LIROBJ('OBJET ',MTAB1,0,IRETOU) if( iretou.eq.0) then IF(MOBJCO.NE.0) THEN MTAB1=MTABLE MTABLE=MOBJCO ELSE MOTERR(1:8)='OBJET ' CALL ERREUR(37) ENDIF ENDIF IF(IERR.NE.0) RETURN SEGACT MTAB1 SEGACT MTABLE*MOD IN=MTAB1.MLOTAB DO 1 I =1,IN IF( MTAB1.MTABTV(I) .NE.'PROCEDUR') GO TO 1 IF( MTAB1.MTABTI(I) .NE.'METHODE ') GO TO 1 IOBJ = MTAB1.MTABIV(I) IMET = MTAB1.MTABII(I) DO 2 K=1,MLOTAB IF(MTABII(K).NE.IMET) GO TO 2 IF(MTABTI(K).NE.'METHODE ') GO TO 2 * l'indice existe on remplace MTABIV(K)=IOBJ MTABTV(K)='PROCEDUR' GO TO 1 2 CONTINUE * l'indice n'existe pas on l'ajoute M = MTABII(/1) IF(M.EQ.MLOTAB) THEN M = M + 20 SEGADJ MTABLE ENDIF MLOTAB=MLOTAB+1 MTABII(MLOTAB) = IMET MTABIV(MLOTAB) = IOBJ MTABTI(MLOTAB)='METHODE ' MTABTV(MLOTAB) = 'PROCEDUR' 1 CONTINUE SEGDES MTAB1,MTABLE RETURN END