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    CB215821  25/04/23    21:15:24     12247          
  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. -INC SMCOORD
  24.  
  25. C Activation de l'objet :
  26.       RI1 = IPRIG1
  27.       RI2 = IPRIG2
  28.       SEGACT, RI1, RI2
  29.  
  30. C---- CAS RIGIDITE VIDE EN ARGUMENT ----C
  31.  
  32.       NRE1 = RI1.IRIGEL(/2)
  33.       IF (NRE1.EQ.0) THEN
  34.         CALL ECROBJ('RIGIDITE',IPRIG1)
  35.         RETURN
  36.       ENDIF
  37.  
  38.       NRE2 = RI2.IRIGEL(/2)
  39.       IF (NRE2.EQ.0) THEN
  40.         CALL ECROBJ('RIGIDITE',IPRIG2)
  41.         RETURN
  42.       ENDIF
  43.  
  44. C---- CAS GENERAL ----C
  45.  
  46. C Identification des rigidites elementaires communes (INTERI(i) = 1)
  47. C Deux rigidites sont communes si COERIG et tableau IRIGEL identiques
  48.       NRIGEL = NRE1 + NRE2
  49.       SEGINI, MRIGID
  50.       IF (RI1.MTYMAT.EQ.RI2.MTYMAT) MTYMAT = RI1.MTYMAT
  51.       NRI1   = 0
  52.       DO 100 I1=1,NRE1
  53.         COERI1 = RI1.COERIG(I1)
  54.         IRIG11 = RI1.IRIGEL(1,I1)
  55.         IRIG21 = RI1.IRIGEL(2,I1)
  56.         IRIG31 = RI1.IRIGEL(3,I1)
  57.         IRIG41 = RI1.IRIGEL(4,I1)
  58.         IRIG51 = RI1.IRIGEL(5,I1)
  59.         IRIG61 = RI1.IRIGEL(6,I1)
  60.         IRIG71 = RI1.IRIGEL(7,I1)
  61.         DO 110 I2=1,NRE2
  62. *          write(6,*) ' rigidites I1, I2', I1, I2
  63.           COERI2 = RI2.COERIG(I2)
  64.           IF (COERI1.NE.COERI2) GOTO 110
  65.           IRIG12 = RI2.IRIGEL(1,I2)
  66.           IF (IRIG11.NE.IRIG12) GOTO 110
  67.           IRIG22 = RI2.IRIGEL(2,I2)
  68.           IF (IRIG21.NE.IRIG22) GOTO 110
  69.           IRIG32 = RI2.IRIGEL(3,I2)
  70.           IF (IRIG31.NE.IRIG32) GOTO 110
  71.           IRIG42 = RI2.IRIGEL(4,I2)
  72.           IF (IRIG41.NE.IRIG42) GOTO 110
  73.           IRIG52 = RI2.IRIGEL(5,I2)
  74.           IF (IRIG51.NE.IRIG52) GOTO 110
  75.           IRIG62 = RI2.IRIGEL(6,I2)
  76.           IF (IRIG61.NE.IRIG62) GOTO 110
  77.           IRIG72 = RI2.IRIGEL(7,I2)
  78.           IF (IRIG71.NE.IRIG72) GOTO 110
  79.           NRI1 = NRI1 + 1
  80.           COERIG(NRI1)   = COERI1
  81.           IRIGEL(1,NRI1) = IRIG11
  82.           IRIGEL(2,NRI1) = IRIG21
  83.           IRIGEL(3,NRI1) = IRIG31
  84.           IRIGEL(4,NRI1) = IRIG41
  85.           IRIGEL(5,NRI1) = IRIG51
  86.           IRIGEL(6,NRI1) = IRIG61
  87.           IRIGEL(7,NRI1) = IRIG71
  88.           GOTO 100
  89.  110    CONTINUE
  90.  100  CONTINUE
  91.       IF (NRIGEL.NE.NRI1) THEN
  92.         NRIGEL = NRI1
  93.         SEGADJ, MRIGID
  94.       ENDIF
  95.  
  96. C Ecriture resultat dans la pile :
  97.       CALL ECROBJ('RIGIDITE',MRIGID)
  98.  
  99.       RETURN
  100.       END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  

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