Télécharger la plaquette Cast3M


fr en

Télécharger difrig.eso

Retour à la liste

Numérotation des lignes : 

difrig

  1. C DIFRIG    SOURCE    FANDEUR   22/01/19    21:15:04     11256          
  2.       SUBROUTINE DIFRIG(IPRIG1,IPRIG2)
  3. C----------------------------------------------------------------------C
  4. C    DIFFERENCE SYMETRIQUE ENTRE DEUX RIGIDITES.
  5. C
  6. C    SYNTAXE : RIG1 = DIFF RIG2 RIG3
  7.  
  8. C    Rq. : l'operation est faite sur les pointeurs des rigidites elem.
  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.       SEGMENT INTERI(NRI1)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMRIGID
  26.  
  27. C Activation de l'objet :
  28.       RI1 = IPRIG1
  29.       RI2 = IPRIG2
  30.       SEGACT, RI1, RI2
  31.  
  32. C---- CAS RIGELE VIDE EN ARGUMENT ----C
  33.  
  34.       NRE1 = RI1.IRIGEL(/2)
  35.       IF (NRE1.EQ.0) THEN
  36.         CALL ECROBJ('RIGIDITE',IPRIG2)
  37.         RETURN
  38.       ENDIF
  39.  
  40.       NRE2 = RI2.IRIGEL(/2)
  41.       IF (NRE2.EQ.0) THEN
  42.         CALL ECROBJ('RIGIDITE',IPRIG1)
  43.         RETURN
  44.       ENDIF
  45.  
  46. C---- CAS GENERAL ----C
  47.  
  48. C Identification des rigidites elementaires communes (INTERI(i) = 1)
  49. C Deux rigidites sont communes si COERIG et tableau IRIGEL identiques
  50.       NRC1 = 0
  51.       NRI1 = NRE1 + NRE2
  52.       SEGINI, INTERI
  53.       DO 100 I1=1,NRE1
  54.         COERI1 = RI1.COERIG(I1)
  55.         IRIG11 = RI1.IRIGEL(1,I1)
  56.         IRIG21 = RI1.IRIGEL(2,I1)
  57.         IRIG31 = RI1.IRIGEL(3,I1)
  58.         IRIG41 = RI1.IRIGEL(4,I1)
  59.         IRIG51 = RI1.IRIGEL(5,I1)
  60.         IRIG61 = RI1.IRIGEL(6,I1)
  61.         IRIG71 = RI1.IRIGEL(7,I1)
  62.         DO 110 I2=1,NRE2
  63. *          write(6,*) ' rigidites I1, I2', I1, I2
  64.           IF (INTERI(I1).NE.0) GOTO 100
  65.           COERI2 = RI2.COERIG(I2)
  66.           IF (COERI1.NE.COERI2) GOTO 111
  67.           IRIG12 = RI2.IRIGEL(1,I2)
  68.           IF (IRIG11.NE.IRIG12) GOTO 112
  69.           IRIG22 = RI2.IRIGEL(2,I2)
  70.           IF (IRIG21.NE.IRIG22) GOTO 113
  71.           IRIG32 = RI2.IRIGEL(3,I2)
  72.           IF (IRIG31.NE.IRIG32) GOTO 114
  73.           IRIG42 = RI2.IRIGEL(4,I2)
  74.           IF (IRIG41.NE.IRIG42) GOTO 115
  75.           IRIG52 = RI2.IRIGEL(5,I2)
  76.           IF (IRIG51.NE.IRIG52) GOTO 116
  77.           IRIG62 = RI2.IRIGEL(6,I2)
  78.           IF (IRIG61.NE.IRIG62) GOTO 117
  79.           IRIG72 = RI2.IRIGEL(7,I2)
  80.           IF (IRIG71.NE.IRIG72) GOTO 118
  81.           INTERI(I1) = 1
  82.           INTERI(NRE1+I2) = 1
  83.           NRC1 = NRC1 + 1
  84.           GOTO 110
  85.  111      CONTINUE
  86. *          WRITE(6,*) 'COERIG' 
  87.           GOTO 110
  88.  112      CONTINUE
  89. *          WRITE(6,*) 'IRIGEL 1' 
  90.           GOTO 110
  91.  113      CONTINUE
  92. *          WRITE(6,*) 'IRIGEL 2' 
  93.           GOTO 110
  94.  114      CONTINUE
  95. *          WRITE(6,*) 'IRIGEL 3' 
  96.           GOTO 110
  97.  115      CONTINUE
  98. *          WRITE(6,*) 'IRIGEL 4' 
  99.           GOTO 110
  100.  116      CONTINUE
  101. *          WRITE(6,*) 'IRIGEL 5' 
  102.           GOTO 110
  103.  117      CONTINUE
  104. *          WRITE(6,*) 'IRIGEL 6' 
  105.           GOTO 110
  106.  118      CONTINUE
  107. *          WRITE(6,*) 'IRIGEL 7' 
  108.  110    CONTINUE
  109.  100  CONTINUE
  110.  
  111. *      write(6,*) 'INTERI =',(INTERI(ii),ii=1,NRI1)
  112.  
  113. C Copie des parties non communes de chaque rigidite :
  114. C Copie 1ere rigidite
  115.       IF (NRC1.EQ.0) THEN
  116.         IPRIG3 = IPRIG1
  117.       ELSE
  118.         NRE3 = 0
  119.         NRIGEL = NRE1
  120.         SEGINI, RI3
  121.         RI3.MTYMAT = RI1.MTYMAT
  122.         RI3.IFORIG = RI1.IFORIG
  123.         DO 200 I1=1,NRE1
  124.           IF (INTERI(I1).EQ.1) GOTO 200
  125.           NRE3 = NRE3 + 1
  126.           RI3.COERIG(NRE3) = RI1.COERIG(I1)
  127.           RI3.IRIGEL(1,NRE3) = RI1.IRIGEL(1,I1)
  128.           RI3.IRIGEL(2,NRE3) = RI1.IRIGEL(2,I1)
  129.           RI3.IRIGEL(3,NRE3) = RI1.IRIGEL(3,I1)
  130.           RI3.IRIGEL(4,NRE3) = RI1.IRIGEL(4,I1)
  131.           RI3.IRIGEL(5,NRE3) = RI1.IRIGEL(5,I1)
  132.           RI3.IRIGEL(6,NRE3) = RI1.IRIGEL(6,I1)
  133.           RI3.IRIGEL(7,NRE3) = RI1.IRIGEL(7,I1)
  134.  200    CONTINUE
  135. *        write(6,*) '  ***** NRE3 =',NRE3
  136.         NRIGEL = NRE3
  137.         SEGADJ, RI3
  138.         IPRIG3 = RI3
  139.       ENDIF
  140. C Copie 2e rigidite
  141.       IF (NRC1.EQ.0) THEN
  142.         IPRIG4 = IPRIG2
  143.       ELSE
  144.         NRE4 = 0
  145.         NRIGEL = NRE2
  146.         SEGINI, RI4
  147.         RI4.MTYMAT = RI2.MTYMAT
  148.         RI4.IFORIG = RI2.IFORIG
  149.         DO 210 I2=1,NRE2
  150.           IF (INTERI(NRE1+I2).EQ.1) GOTO 210
  151.           NRE4 = NRE4 + 1
  152.           RI4.COERIG(NRE4)   = RI2.COERIG(I2)
  153.           RI4.IRIGEL(1,NRE4) = RI2.IRIGEL(1,I2)
  154.           RI4.IRIGEL(2,NRE4) = RI2.IRIGEL(2,I2)
  155.           RI4.IRIGEL(3,NRE4) = RI2.IRIGEL(3,I2)
  156.           RI4.IRIGEL(4,NRE4) = RI2.IRIGEL(4,I2)
  157.           RI4.IRIGEL(5,NRE4) = RI2.IRIGEL(5,I2)
  158.           RI4.IRIGEL(6,NRE4) = RI2.IRIGEL(6,I2)
  159.           RI4.IRIGEL(7,NRE4) = RI2.IRIGEL(7,I2)
  160.  210    CONTINUE
  161. *        write(6,*) '  ***** NRE4 =',NRE4
  162.         NRIGEL = NRE4
  163.         SEGADJ, RI4
  164.         IPRIG4 = RI4
  165.       ENDIF
  166.  
  167. C Fusion des 2 copies :
  168.       CALL FUSRIG(IPRIG3,IPRIG4,IPRIG0)
  169.       IF (IERR.NE.0) RETURN
  170.  
  171. C Ecriture resultat dans la pile :
  172.       CALL ECROBJ('RIGIDITE',IPRIG0)
  173.  
  174.       RETURN
  175.       END
  176.  
  177.  
  178.  

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