Télécharger cmct1.eso

Retour à la liste

Numérotation des lignes :

  1. C CMCT1 SOURCE CHAT 09/10/09 21:16:23 6519
  2. SUBROUTINE CMCT1(ICHP,IRIG,IRIG2)
  3. *_______________________________________________________________________
  4. c
  5. c opérateur cmct
  6. c
  7. c entrée
  8. c ICHP : champ par point qui stocke la masse inversée
  9. c IRIG : rigidité contenant les blocages
  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. -INC SMCHPOI
  24. * stockage des noms de tous les composantes primales.
  25. SEGMENT LSINCP
  26. CHARACTER*4 LISINP(NLIGP)
  27. ENDSEGMENT
  28. * correspondance entre les noms de composantes locale LISINC
  29. * et les nom de composantes dans LSINCP
  30. SEGMENT CORES1
  31. INTEGER IPCOR2(NRIGEL)
  32. ENDSEGMENT
  33. SEGMENT CORES2
  34. INTEGER COR2(NLIGRP)
  35. ENDSEGMENT
  36. * tableau pour dire en chaque point si la composante du tableau LISINP
  37. * est implquée
  38. SEGMENT MTOPTS
  39. * nombre d'occurence de la compoosante
  40. INTEGER ITOPTS(NBPTS,NLIGP)
  41. * valeur de l'inverse la masse en ce point
  42. REAL*8 XTOPTS(NBPTS,NLIGP+1)
  43. ENDSEGMENT
  44. *
  45. * tableau pour pointer vers MCOEF à partir du nombre d'inconnues
  46. *
  47. SEGMENT LSINCO
  48. INTEGER LESINC(NINC,2)
  49. REAL*8 XMAS(NINC)
  50. ENDSEGMENT
  51. *
  52. * tableau des coefficient de la matrice C
  53. * ordonné dans l'ordre des inconnues
  54. SEGMENT MCOEF
  55. * numero du noeud support du multiplicateur ligne 1
  56. * est il en marié avec un autre multiplicateur ligne 2
  57. INTEGER ICOEF(2,NCOEF)
  58. * valeur des coefficients
  59. REAL*8 XCOEF(NCOEF)
  60. ENDSEGMENT
  61. *
  62. *_______________________________________________________________________
  63. *
  64. * la première etape consiste à établir la liste de tous les noms
  65. * d'inconnue primale dans la rigidité
  66. * cette liste est stockée dans LSINCP
  67. * la correspondance locale -> globale dans CORES1
  68. *
  69. * la rigidité est déjà active (cmct)
  70. MRIGID = IRIG
  71. NRIGEL = IRIGEL(/2)
  72. SEGINI CORES1
  73. * NLIGP1 est la taille effective de LSINCP
  74. * on évite ainsi de faire trop de segadj
  75. NLIGP1 = 0
  76. NLIGP = 0
  77. NCOEF = 0
  78.  
  79.  
  80. DO 50 I=1,NRIGEL
  81. DESCR = IRIGEL(3,I)
  82. SEGACT DESCR*NOMOD
  83. NLIGRP = LISINC(/2)
  84. NLIGP = NLIGP + NLIGRP
  85. MELEME = IRIGEL(1,I)
  86. NCOEF = NCOEF + (NUM(/2) * NLIGRP)
  87. * les coeffficients sur les multiplicateurs
  88. * ne nous interessent pas
  89. IF (ITYPEL .EQ. 22) NCOEF=NCOEF-NUM(/2)
  90. 50 CONTINUE
  91. *
  92. SEGINI LSINCP
  93. DO 300 I=1,NRIGEL
  94. DESCR = IRIGEL(3,I)
  95. NLIGRP = LISINC(/2)
  96. MELEME = IRIGEL(1,I)
  97. IMULT=1
  98. IF (ITYPEL .EQ.22) IMULT = 2
  99. SEGINI CORES2
  100. DO 200 J=IMULT,NLIGRP
  101. DO 100 K=1,NLIGP
  102. IF (LISINC(J) .EQ. LISINP(K)) THEN
  103. COR2(J) = K
  104. GOTO 200
  105. ENDIF
  106. 100 CONTINUE
  107. NLIGP1 = NLIGP1 + 1
  108. LISINP(NLIGP1) = LISINC(J)
  109. COR2(J) = NLIGP1
  110. 200 CONTINUE
  111. IPCOR2(I) = CORES2
  112. 300 CONTINUE
  113. *
  114. * ajustement de la taille de LSINCP
  115. * on purrait suprimer cette ligne
  116. NLIGP = NLIGP1
  117. SEGADJ LSINCP
  118. *
  119. *
  120. *_______________________________________________________________________
  121. * on remplit maintenant le tableau itopts en bouclant sur les sous zones de
  122. * la rigidité
  123. *
  124. NBPTS = XCOOR(/1) / (IDIM +1)
  125. SEGINI MTOPTS
  126. *
  127. DO 600 I=1,NRIGEL
  128. * les maillages sont actifs depuis cmct
  129. MELEME = IRIGEL(1,I)
  130. imult=1
  131. IF (ITYPEL .EQ.22) IMULT = 2
  132. DESCR = IRIGEL(3,I)
  133. CORES2 = IPCOR2(I)
  134. DO 500 K=1,NUM(/2)
  135. DO 400 J=IMULT,NOELEP(/1)
  136. ITOPTS(NUM(NOELEP(J),K),COR2(J)) =
  137. & ITOPTS(NUM(NOELEP(J),K),COR2(J)) + 1
  138. 400 CONTINUE
  139. 500 CONTINUE
  140. 600 CONTINUE
  141. *
  142. * on remplit maintenant la masse inversée
  143. *
  144. MCHPOI = ICHP
  145. SEGACT MCHPOI*NOMOD
  146. * boucle sur les sous zones du champ par point
  147. DO 1100 I=1,IPCHP(/1)
  148. MSOUPO = IPCHP(I)
  149. SEGACT MSOUPO
  150. MELEME = IGEOC
  151. SEGACT MELEME
  152. MPOVAL = IPOVAL
  153. SEGACT MPOVAL
  154. * boucle sur les composantes de la sous zone
  155. DO 1000 J=1,NOCOMP(/2)
  156. * recuperation du numéro de la composante dans LISINP
  157. DO 700 K=1,NLIGP
  158. IF (NOCOMP(J) .EQ. LISINP(K)) THEN
  159. IDK = K
  160. GOTO 800
  161. ENDIF
  162. 700 CONTINUE
  163. IDK = NLIGP + 1
  164. *
  165. 800 CONTINUE
  166. * boucle sur les points de la sous zone
  167. DO 900 K=1,NUM(/2)
  168. XTOPTS(NUM(1,K),IDK) = VPOCHA(K,J)
  169. 900 CONTINUE
  170. *
  171. 1000 CONTINUE
  172. SEGDES MPOVAL,MELEME,MSOUPO
  173. 1100 CONTINUE
  174. *
  175. SEGDES MCHPOI
  176. *
  177. *_______________________________________________________________________
  178. *
  179. * calcul du nombre d'inconnues et creation de LESINC
  180. * correspondance entre les inconnues et MCOEF
  181. *
  182. *
  183. NINC = 0
  184. DO 1300 I=1,NLIGP
  185. DO 1200 J=1,NBPTS
  186. NINC = NINC + SIGN(1,(ITOPTS(J,I)-1))
  187. 1200 CONTINUE
  188. 1300 CONTINUE
  189. NINC = ((NLIGP * NBPTS) + NINC )/ 2
  190. **
  191. * on remplit LSINCO
  192. SEGINI LSINCO
  193. IND1 = 1
  194. IDUM = 1
  195. DO 1600 I=1,NRIGEL
  196. MELEME = IRIGEL(1,I)
  197. imult=1
  198. IF (ITYPEL .EQ.22) IMULT = 2
  199. DESCR = IRIGEL(3,I)
  200. CORES2 = IPCOR2(I)
  201. DO 1500 K=1,NUM(/2)
  202. DO 1400 J=IMULT,NOELEP(/1)
  203. IF ( ITOPTS(NUM(NOELEP(J),K),COR2(J)) .GT. 0 ) THEN
  204. LESINC(IND1,1) = IDUM
  205. IDUM = IDUM + ITOPTS(NUM(NOELEP(J),K),COR2(J))
  206. * ITOPTS va desormais contenir le numéro de l'inconnue dans LESINC
  207. ITOPTS(NUM(NOELEP(J),K),COR2(J)) = -1 * IND1
  208. XMAS(IND1) = XTOPTS(NUM(NOELEP(J),K),COR2(J))
  209. IND1 = IND1 + 1
  210. ENDIF
  211. 1400 CONTINUE
  212. 1500 CONTINUE
  213. 1600 CONTINUE
  214. *=====
  215. * if ( (IND1-1) .NE. NINC ) then
  216. * write(*,*) 'erreur dans boucle lsinco'
  217. * endif
  218. *======
  219. *
  220. *
  221. *_______________________________________________________________________
  222. * remplissage de MCOEF
  223. *
  224. SEGINI MCOEF
  225. DO 1900 I=1,NRIGEL
  226. MELEME = IRIGEL(1,I)
  227. imult=1
  228. IF (ITYPEL .EQ.22) IMULT = 2
  229. DESCR = IRIGEL(3,I)
  230. CORES2 = IPCOR2(I)
  231. xMATRI = IRIGEL(4,I)
  232. SEGACT xMATRI
  233. DO 1800 K=1,NUM(/2)
  234. * XMATRI = IMATTT(K)
  235. * SEGACT XMATRI
  236. DO 1700 J=IMULT,NOELEP(/1)
  237. NNINC = -1 * ITOPTS(NUM(NOELEP(J),K),COR2(J))
  238. IDMCOE = LESINC(NNINC,1)+LESINC(NNINC,2)
  239. LESINC(NNINC,2) = LESINC(NNINC,2) + 1
  240. ICOEF(1,IDMCOE)=NUM(1,K)
  241. XCOEF(IDMCOE)=RE(1,J,k)*COERIG(I)
  242. 1700 CONTINUE
  243. * SEGDES XMATRI
  244. 1800 CONTINUE
  245. * on referme la boutique
  246. SEGDES xMATRI,MELEME,DESCR
  247. SEGSUP CORES2
  248. 1900 CONTINUE
  249. SEGSUP CORES1,LSINCP,MTOPTS
  250. *
  251. *=====
  252. * do 2001 i=1,ninc
  253. * write(*,2003) i,lesinc(i,1),lesinc(i,2),xmas(i)
  254. * 2001 continue
  255. * 2003 format(I3,1X,I3,1X,I3,2X,E12.5)
  256. *
  257. * do 2005 i=1,ncoef
  258. * write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i)
  259. * 2005 continue
  260. *=====
  261. *_______________________________________________________________________
  262. *
  263. * il ne reste plus qu' a creer les matrices élémentaires
  264. *
  265. CALL CMCT2(MCOEF,LSINCO,IRIG2)
  266. IF (IERR .NE.0 ) RETURN
  267. *
  268. *_______________________________________________________________________
  269. RETURN
  270. END
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  

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