Télécharger cmct2.eso

Retour à la liste

Numérotation des lignes :

  1. C CMCT2 SOURCE CHAT 09/10/09 21:16:24 6519
  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 CCOPTIO
  20. -INC SMRIGID
  21. -INC SMELEME
  22. -INC SMCOORD
  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. NRIGE = 7
  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. * SEGINI XMATRI
  117. * IMATTT(1)=XMATRI
  118. DO 600 J=1,NLIGRP
  119. DO 500 K=1,NLIGRP
  120. RE(K,J,1)=XDUM(K)*XDUM(J)*XMAS(I)
  121. 500 CONTINUE
  122. 600 CONTINUE
  123. *
  124. * dans le cas des doubles multiplicateurs il faut rajouter la matrice
  125. * bidiagonale
  126. *
  127. INOEU = 0
  128. DO 650 J=0,LESINC(I,2)-1
  129. INOEU = INOEU + 1
  130. IF (ICOEF(2,J+LESINC(I,1)).NE.0) THEN
  131. RE(INOEU,INOEU+1,1)=RE(INOEU,INOEU+1,1) +
  132. & RE(INOEU,INOEU,1)/1.5D0
  133. RE(INOEU,INOEU,1)= RE(INOEU,INOEU,1)/3.D0
  134. RE(INOEU+1,INOEU+1,1)=RE(INOEU,INOEU,1)
  135. RE(INOEU+1,INOEU,1)=RE(INOEU,INOEU+1,1)
  136. INOEU = INOEU + 1
  137. NUM(INOEU,1) = ICOEF(2,J+LESINC(I,1))
  138. XDUM(INOEU) = XDUM(INOEU-1)
  139. ENDIF
  140. 650 CONTINUE
  141. SEGDES XMATRI
  142. * SEGACT XMATRI
  143. *
  144. SEGDES DESCR
  145. * SEGDES XMATRI,IMATRI
  146. SEGSUP WORK1
  147. SEGDES MELEME
  148. 700 CONTINUE
  149. *
  150. SEGSUP LSINCO,MCOEF
  151. SEGDES MRIGID
  152. *_______________________________________________________________________
  153. RETURN
  154. END
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  

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