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