Télécharger la plaquette Cast3M


fr en

Télécharger intrig.eso

Retour à la liste

Numérotation des lignes : 

intrig

  1. C INTRIG    SOURCE    PASCAL    20/12/02    21:15:11     10798          
  2.       SUBROUTINE INTRIG(IPRIG1,IPRIG2)
  3. C----------------------------------------------------------------------C
  4. C    INTERSECTION DEUX RIGIDITES
  5. C
  6. C    SYNTAXE : RIG1 = INTE RIG2 RIG3
  7.  
  8. C    Rq. : l'operation est faite sur les sous-zones
  9. C
  10. C    ENTREES :
  11. C      - IPRIG1 = RIG2
  12. C      - IPRIG2 = RIG3 
  13.  
  14. C    SORTIE : le resultat est renvoye dans la pile.
  15. C
  16. C----------------------------------------------------------------------C
  17.  
  18.       IMPLICIT INTEGER(I-N)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMRIGID
  23.  
  24. C Activation de l'objet :
  25.       RI1 = IPRIG1
  26.       RI2 = IPRIG2
  27.       SEGACT, RI1, RI2
  28.  
  29. C---- CAS RIGIDITE VIDE EN ARGUMENT ----C
  30.  
  31.       NRE1 = RI1.IRIGEL(/2)
  32.       IF (NRE1.EQ.0) THEN
  33.         CALL ECROBJ('RIGIDITE',IPRIG1)
  34.         RETURN
  35.       ENDIF
  36.  
  37.       NRE2 = RI2.IRIGEL(/2)
  38.       IF (NRE2.EQ.0) THEN
  39.         CALL ECROBJ('RIGIDITE',IPRIG2)
  40.         RETURN
  41.       ENDIF
  42.  
  43. C---- CAS GENERAL ----C
  44.  
  45. C Identification des rigidites elementaires communes (INTERI(i) = 1)
  46. C Deux rigidites sont communes si COERIG et tableau IRIGEL identiques
  47.       NRIGEL = NRE1 + NRE2
  48.       SEGINI, MRIGID
  49.       IF (RI1.MTYMAT.EQ.RI2.MTYMAT) MTYMAT = RI1.MTYMAT
  50.       NRI1   = 0
  51.       DO 100 I1=1,NRE1
  52.         COERI1 = RI1.COERIG(I1)
  53.         IRIG11 = RI1.IRIGEL(1,I1)
  54.         IRIG21 = RI1.IRIGEL(2,I1)
  55.         IRIG31 = RI1.IRIGEL(3,I1)
  56.         IRIG41 = RI1.IRIGEL(4,I1)
  57.         IRIG51 = RI1.IRIGEL(5,I1)
  58.         IRIG61 = RI1.IRIGEL(6,I1)
  59.         IRIG71 = RI1.IRIGEL(7,I1)
  60.         DO 110 I2=1,NRE2
  61. *          write(6,*) ' rigidites I1, I2', I1, I2
  62.           COERI2 = RI2.COERIG(I2)
  63.           IF (COERI1.NE.COERI2) GOTO 110
  64.           IRIG12 = RI2.IRIGEL(1,I2)
  65.           IF (IRIG11.NE.IRIG12) GOTO 110
  66.           IRIG22 = RI2.IRIGEL(2,I2)
  67.           IF (IRIG21.NE.IRIG22) GOTO 110
  68.           IRIG32 = RI2.IRIGEL(3,I2)
  69.           IF (IRIG31.NE.IRIG32) GOTO 110
  70.           IRIG42 = RI2.IRIGEL(4,I2)
  71.           IF (IRIG41.NE.IRIG42) GOTO 110
  72.           IRIG52 = RI2.IRIGEL(5,I2)
  73.           IF (IRIG51.NE.IRIG52) GOTO 110
  74.           IRIG62 = RI2.IRIGEL(6,I2)
  75.           IF (IRIG61.NE.IRIG62) GOTO 110
  76.           IRIG72 = RI2.IRIGEL(7,I2)
  77.           IF (IRIG71.NE.IRIG72) GOTO 110
  78.           NRI1 = NRI1 + 1
  79.           COERIG(NRI1)   = COERI1
  80.           IRIGEL(1,NRI1) = IRIG11
  81.           IRIGEL(2,NRI1) = IRIG21
  82.           IRIGEL(3,NRI1) = IRIG31
  83.           IRIGEL(4,NRI1) = IRIG41
  84.           IRIGEL(5,NRI1) = IRIG51
  85.           IRIGEL(6,NRI1) = IRIG61
  86.           IRIGEL(7,NRI1) = IRIG71
  87.           GOTO 100
  88.  110    CONTINUE
  89.  100  CONTINUE
  90.       IF (NRIGEL.NE.NRI1) THEN
  91.         NRIGEL = NRI1
  92.         SEGADJ, MRIGID
  93.       ENDIF
  94.  
  95. C Ecriture resultat dans la pile :
  96.       CALL ECROBJ('RIGIDITE',MRIGID)
  97.  
  98.       RETURN
  99.       END
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  

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