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

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