Télécharger la plaquette Cast3M


fr en

Télécharger cmct2.eso

Retour à la liste

Numérotation des lignes : 

cmct2

  1. C CMCT2     SOURCE    CB215821  25/04/23    21:15:05     12247          
  2.       SUBROUTINE CMCT2(MCOEF,LSINCO,IRIG2)
  3. *_______________________________________________________________________
  4. c
  5. c      opérateur cmct
  6. c
  7. c entrée
  8. c   MCOEF : coefficient de la matrice de blocage reordonnés
  9. c   LSINCO : indice du dit tableau
  10. c
  11. c sortie
  12. c   IRIG2 : rigidité contenant la matrice condensée
  13. c
  14. *_______________________________________________________________________
  15.  
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMRIGID
  22. -INC SMCOORD
  23. -INC SMELEME
  24. *
  25. * tableau pour pointer vers MCOEF à partir du nombre d'inconnues
  26. *
  27.       SEGMENT LSINCO
  28.           INTEGER LESINC(NINC,2)
  29.           REAL*8  XMAS(NINC)
  30.       ENDSEGMENT
  31. *
  32. *  tableau des coefficient de la matrice C
  33. *  ordonné dans l'ordre des inconnues
  34.       SEGMENT MCOEF
  35. *        numero du noeud support du multiplicateur ligne 1
  36. *        est il en marié avec un autre multiplicateur ligne 2
  37.          INTEGER ICOEF(2,NCOEF)
  38. *         valeur des coefficients
  39.          REAL*8 XCOEF(NCOEF)
  40.       ENDSEGMENT
  41. *
  42.       SEGMENT WORK1
  43.             REAL*8 XDUM(NBNN)
  44.       ENDSEGMENT
  45.       LOGICAL NOER
  46. *_______________________________________________________________________
  47.  
  48.       NOER = .TRUE.
  49. *  il y a autant de matrices élémentaires qu'il y a de coefficients
  50. *
  51.       NRIGEL = LESINC(/1)
  52.       SEGINI MRIGID
  53.       IRIG2 = MRIGID
  54.       MTYMAT = 'RIGIDITE'
  55. *
  56. *    boucle sur les sous zones
  57. *
  58.       DO 700 I=1,NRIGEL
  59.         GRXDUM = 0.D0
  60.         PTXDUM = 9.D50
  61.         COERIG(I) = 1.D0
  62.         NBNN = LESINC(I,2)
  63. *
  64. *  il faut tenir compte des doubles multiplicateurs
  65.         DO 100 J=0,LESINC(I,2)-1
  66.             IF (ICOEF(2,J+LESINC(I,1)).NE.0) NBNN = NBNN + 1
  67.  100    CONTINUE
  68. *
  69. * creation du maillage et du vecteur des coefficients
  70.         NBELEM = 1
  71.         NBSOUS = 0
  72.         NBREF = 0
  73.         SEGINI WORK1
  74.         SEGINI MELEME
  75.         INOEU = 0
  76.         DO 200 J=0,LESINC(I,2)-1
  77.              INOEU = INOEU + 1
  78.              NUM(INOEU,1) = ICOEF(1,J+LESINC(I,1))
  79.              XDUM(INOEU) = XCOEF(J+LESINC(I,1))
  80.              IF (ICOEF(2,J+LESINC(I,1)).NE.0) THEN
  81.                 INOEU = INOEU + 1
  82.                 NUM(INOEU,1) = ICOEF(2,J+LESINC(I,1))
  83.                 XDUM(INOEU) = XDUM(INOEU-1)
  84.              ENDIF
  85.              GRXDUM=MAX(GRXDUM,ABS(XDUM(INOEU)))
  86.              IF (XDUM(INOEU).NE.0.D0) THEN
  87.                 PTXDUM=MIN(PTXDUM,ABS(XDUM(INOEU)))
  88.              ENDIF
  89.  200    CONTINUE
  90. *
  91. *  petit controle sur le conditionnement de la matrice
  92.         IF (((PTXDUM/GRXDUM).LT.1.D-12).AND.NOER) THEN
  93.            CALL ERREUR(-320)
  94.            NOER = .FALSE.
  95.         ENDIF
  96.         ITYPEL = 29
  97.         IRIGEL(1,I) = MELEME
  98. *
  99. *    segment descripteur DESCR
  100.         NLIGRP = NBNN
  101.         NLIGRD = NBNN
  102.         SEGINI DESCR
  103.         DO 300 J=1,NBNN
  104.           LISINC(J)='LX  '
  105.           LISDUA(J)='FLX '
  106.           NOELEP(J)=J
  107.           NOELED(J)=J
  108.  300    CONTINUE
  109.         IRIGEL(3,I) = DESCR
  110. *
  111. *   la matrice elle meme
  112. *
  113.          NELRIG = 1
  114.          SEGINI xMATRI
  115.          IRIGEL(4,I)=xMATRI
  116.          DO 600 J=1,NLIGRP
  117.            DO 500 K=1,NLIGRP
  118.               RE(K,J,1)=XDUM(K)*XDUM(J)*XMAS(I)
  119.  500       CONTINUE
  120.  600     CONTINUE
  121. *
  122. *     dans le cas des doubles multiplicateurs il faut rajouter la matrice
  123. *    bidiagonale
  124. *
  125.         INOEU = 0
  126.         DO 650 J=0,LESINC(I,2)-1
  127.              INOEU = INOEU + 1
  128.              IF (ICOEF(2,J+LESINC(I,1)).NE.0) THEN
  129.                 RE(INOEU,INOEU+1,1)=RE(INOEU,INOEU+1,1) +
  130.      &                            RE(INOEU,INOEU,1)/1.5D0
  131.                 RE(INOEU,INOEU,1)= RE(INOEU,INOEU,1)/3.D0
  132.                 RE(INOEU+1,INOEU+1,1)=RE(INOEU,INOEU,1)
  133.                 RE(INOEU+1,INOEU,1)=RE(INOEU,INOEU+1,1)
  134.                 INOEU = INOEU + 1
  135.                 NUM(INOEU,1) = ICOEF(2,J+LESINC(I,1))
  136.                 XDUM(INOEU) = XDUM(INOEU-1)
  137.               ENDIF
  138.  650    CONTINUE
  139.          SEGDES XMATRI
  140.         SEGDES DESCR
  141.         SEGSUP WORK1
  142.         SEGDES MELEME
  143.  700  CONTINUE
  144. *
  145.       SEGDES MRIGID
  146. *_______________________________________________________________________
  147.       RETURN
  148.       END
  149.  
  150.  
  151.  
  152.  

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