Télécharger la plaquette Cast3M


fr en

Télécharger herite.eso

Retour à la liste

Numérotation des lignes : 

herite

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales