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

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