Télécharger la plaquette Cast3M


fr en

Télécharger fusrig.eso

Retour à la liste

Numérotation des lignes : 

fusrig

  1. C FUSRIG    SOURCE    CB215821  25/04/23    21:15:21     12247          
  2.  
  3. C=======================================================================
  4. C=                           F U S R I G                               =
  5. C=                           -----------                               =
  6. C=  Ce sousprogramme realise la fusion ('ET') de deux objets RIGIDITE. =
  7. C=======================================================================
  8.  
  9.       SUBROUTINE FUSRIG (IP1,IP2,IRETOU)
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMRIGID
  17. -INC SMCOORD
  18. -INC SMELEME
  19.  
  20.       PARAMETER (IVA=2)
  21.       DIMENSION ITTG(IVA)
  22.  
  23.       IRETOU = 0
  24.       if (ierr.ne.0) return
  25.  
  26.       RI1 = IP1
  27.       RI2 = IP2
  28.       SEGACT,RI1,RI2
  29.       NRIG1 = RI1.IRIGEL(/2)
  30.       NRIG2 = RI2.IRIGEL(/2)
  31.  
  32.       ITTG(1)=IP1
  33.       ITTG(2)=IP2
  34.  
  35.       NRIGEL = NRIG1 + NRIG2
  36.  
  37.       SEGINI,MRIGID
  38.       ICHOLE = 0
  39.       IMGEO1 = 0
  40.  
  41.       IC=0
  42.       DO i=1,IVA
  43.         RI4=ITTG(i)
  44.         JA=RI4.IRIGEL(/2)
  45.         JB=RI4.IRIGEL(/1)
  46.         DO k=1,JA
  47.           MELEME=RI4.IRIGEL(1,k)
  48.           SEGACT,MELEME
  49.           IF (NUM(/2).NE.0) THEN
  50.             IC=IC+1
  51.             COERIG(IC)=RI4.COERIG(k)
  52.             DO l=1,JB
  53.               IRIGEL(l,IC)=RI4.IRIGEL(l,k)
  54.             ENDDO
  55.           ENDIF
  56.         ENDDO
  57.       ENDDO
  58.  
  59.       IF (NRIGEL.NE.IC) THEN
  60.         NRIGEL=IC
  61.         SEGADJ,MRIGID
  62.       ENDIF
  63.  
  64. c*c  Les 2 matrices ne sont pas vides :
  65. c*      IF (NRIG1.NE.0 .AND. NRIG2.NE.0) THEN
  66.         IF (RI2.MTYMAT.NE.RI1.MTYMAT) THEN
  67.           IF (RI1.MTYMAT.EQ.'RIGIDITE'.OR.RI2.MTYMAT.EQ.'RIGIDITE') THEN
  68.             MTYMAT='RIGIDITE'
  69.           ELSE
  70.             MTYMAT='INDETERM'
  71.           ENDIF
  72.         ELSE
  73.           MTYMAT=RI1.MTYMAT
  74.         ENDIF
  75.         IF (RI2.IFORIG.NE.RI1.IFORIG) THEN
  76.           interr(1)=RI1.IFORIG
  77.           interr(2)=RI2.IFORIG
  78.           interr(3)=IFOUR
  79. c-dbg      write(ioimp,*) '1132 FUSRIG',ri1,ri2
  80.           call erreur(1132)
  81.           IFORIG = IFOUR
  82.         ELSE
  83.           IFORIG=RI1.IFORIG
  84.         ENDIF
  85. c  Au moins une matrice est vide, voire les 2
  86. c*      ELSE
  87. c*        IF (NRIG1.NE.0) THEN
  88. c*          MTYMAT=RI1.MTYMAT
  89. c*          IFORIG=RI1.IFORIG
  90. c*        ELSE IF (NRIG2.NE.0) THEN
  91. c*          MTYMAT=RI2.MTYMAT
  92. c*          IFORIG=RI2.IFORIG
  93. c*        ELSE
  94. c*          MTYMAT='INDETERM'
  95. c*          IFORIG=IFOUR
  96. c*        ENDIF
  97. c*      ENDIF
  98.  
  99. *  pour le frottement, combinaison de deux raideurs portant sur le meme lx
  100.       call verlag(mrigid)
  101.  
  102.       SEGDES,RI1,RI2
  103.  
  104.       SEGDES,MRIGID
  105.       IRETOU=MRIGID
  106.  
  107.       RETURN
  108.       END
  109.  
  110.  
  111.  
  112.  

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