Télécharger cmct1.eso

Retour à la liste

Numérotation des lignes :

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

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