Download herite.eso

Back to the list

   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