Télécharger cmct3.eso

Retour à la liste

Numérotation des lignes :

  1. C CMCT3 SOURCE PV 17/09/29 21:15:06 9578
  2. SUBROUTINE CMCT3(ICHP,IRIGC,IRIGB,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 M-1
  9. c IRIGB : rigidité B
  10. c IRIGC : rigidité C
  11. c
  12. c sortie
  13. c IRIG2 : rigidité contenant la matrice condensée C M-1 Bt
  14. c
  15. *_______________________________________________________________________
  16.  
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19. *
  20. -INC CCOPTIO
  21. -INC SMRIGID
  22. -INC SMELEME
  23. -INC CCHAMP
  24. -INC SMCOORD
  25. -INC SMCHPOI
  26. *
  27. * Description des objets à traiter
  28. * PNTOB : pointeur de l'objet
  29. * TYPOB : type de l'objet
  30. * PNTCOB : pointeur vers une version locale de l'objet
  31. * pour la RIGIDITE IMAT
  32. * PNTCOB(1,IMAT) pointe vers un CORES1
  33. * PNTCOB(2,IMAT) pointe vers un LSINCO
  34. * PNTCOB(3,IMAT) pointe vers un MCOEF
  35.  
  36. SEGMENT DESCOB
  37. INTEGER PNTOB(NMAT)
  38. INTEGER PNTCOB(4,NMAT)
  39. ENDSEGMENT
  40.  
  41. * stockage des noms de tous les composantes primales.
  42. SEGMENT LSINCP
  43. CHARACTER*4 LISINP(NLIGP)
  44. ENDSEGMENT
  45. * LPSINP(ILIGP,IOBJ) dit si la composante est présente dans l'objet
  46. * IOBJ (Matrice IRIGB, IRIGC ou ICHP)
  47. ** LPSINP(ILIGP,NOBJ+1) dit si la composante est présente dans
  48. ** tous les objets
  49. SEGMENT LLINCP
  50. LOGICAL LLSINP(NLIGP,NOBJ)
  51. ENDSEGMENT
  52.  
  53. * stockage des noms des composantes duales.
  54. SEGMENT LSINCD
  55. CHARACTER*4 LISIND(NLIGD)
  56. ENDSEGMENT
  57. *
  58. * Noms d'inconnues primales correspondant à LISIND
  59. *
  60. SEGMENT CORIDP
  61. CHARACTER*4 LISIDP(NLIGD)
  62. ENDSEGMENT
  63.  
  64. * correspondance entre les noms de composantes locale LISINC
  65. * et les noms de composantes dans LSINCP pour les RIGIDITES
  66. SEGMENT CORES1
  67. INTEGER IPCOR2(NRIGEL)
  68. ENDSEGMENT
  69. SEGMENT CORES2
  70. INTEGER COR2P(NLIGRP)
  71. INTEGER COR2D(NLIGRD)
  72. ENDSEGMENT
  73. *
  74. * tableau pour dire en chaque point si la composante du tableau LISINP
  75. * est impliquée
  76. *
  77. SEGMENT MTOPTS
  78. * nombre d'occurence de la composante
  79. INTEGER ITOPTS(NBPTS,NLIGP+1,NMAT)
  80. ENDSEGMENT
  81. SEGMENT NTOPTS
  82. * valeur de l'inverse la masse en ce point
  83. REAL*8 XTOPTS(NBPTS,NLIGP+1)
  84. ENDSEGMENT
  85. SEGMENT OTOPTS
  86. * valeur de l'inverse la masse en ce point
  87. LOGICAL LTOPTS(NBPTS,NLIGP+1)
  88. ENDSEGMENT
  89. *
  90. * tableau pour pointer vers MCOEF à partir du nombre d'inconnues
  91. *
  92. SEGMENT LSINCO
  93. INTEGER LESINC(NINC+1,2,NMAT)
  94. ENDSEGMENT
  95. SEGMENT LTINCO
  96. REAL*8 XMAS(NINC)
  97. ENDSEGMENT
  98. *
  99. * tableau des coefficient de la matrice C
  100. * ordonné dans l'ordre des inconnues
  101. SEGMENT MCOEF
  102. * numero du noeud support du multiplicateur ligne 1
  103. INTEGER ICOEF(2,NCOEF)
  104. * valeur des coefficients
  105. REAL*8 XCOEF(NCOEF)
  106. ENDSEGMENT
  107. *
  108. SEGMENT WORK1
  109. REAL*8 XDUM(NBNN)
  110. ENDSEGMENT
  111. LOGICAL NOER,LOK,LDBG,LTYP22
  112. *
  113. LDBG=.FALSE.
  114. NMAT=1
  115. IF (IRIGB.NE.IRIGC) NMAT=2
  116. NOBJ=NMAT
  117. IF (ICHP.NE.0) NOBJ=NMAT+1
  118. IF (LDBG) THEN
  119. WRITE(IOIMP,*) 'NMAT=',NMAT
  120. WRITE(IOIMP,*) 'NOBJ=',NOBJ
  121. ENDIF
  122. SEGINI DESCOB
  123. PNTOB(1)=IRIGC
  124. IF (IRIGB.NE.IRIGC) THEN
  125. PNTOB(2)=IRIGB
  126. ENDIF
  127. *_______________________________________________________________________
  128. *
  129. * la première etape consiste à établir la liste de tous les noms
  130. * d'inconnue primale communes à la (aux) rigidités et à l'éventuel
  131. * CHPOINT de masse. Cette liste est stockée dans LSINCP.
  132. * On fait aussi la liste des duales par la même occasion
  133. * On regarde aussi s'il n'y a que des MELEME de type 22, auquel cas
  134. * on peut éviter le compactage du MCOEF (on est sûr que tous les ddls
  135. * duaux sont distincts)
  136. *
  137. * Calcul du nombre maxi
  138. NLIGP = 1000
  139. SEGINI LSINCP,LLINCP
  140. NLIGD = 1000
  141. SEGINI LSINCD
  142. LTYP22=.TRUE.
  143. *
  144. NLIGP1 = 0
  145. NLIGD1 = 0
  146. DO IMAT=1,NMAT
  147. MRIGID=PNTOB(IMAT)
  148. SEGACT MRIGID
  149. NRIGEL=IRIGEL(/2)
  150. DO I=1,NRIGEL
  151. MELEME = IRIGEL(1,I)
  152. SEGACT MELEME
  153. LTYP22=LTYP22.AND.(ITYPEL.EQ.22)
  154. DESCR = IRIGEL(3,I)
  155. SEGACT DESCR
  156. NLIGRP=LISINC(/2)
  157. IDEB=1
  158. IF (ITYPEL.EQ.22) IDEB=2
  159. DO 200 ILIGRP=IDEB,NLIGRP
  160. DO ILIGP1=1,NLIGP1
  161. IF (LISINC(ILIGRP).EQ.LISINP(ILIGP1)) THEN
  162. LLSINP(ILIGP1,IMAT)=.TRUE.
  163. GOTO 200
  164. ENDIF
  165. ENDDO
  166. * Petite astuce car on ne cherche que les composantes primales communes
  167. * à tous les objets donc pas besoin de concaténer celles au-delà
  168. * du premier objet
  169. IF (IMAT.EQ.1) THEN
  170. NLIGP1 = NLIGP1 + 1
  171. IF (NLIGP1.GT.NLIGP) THEN
  172. NLIGP=NLIGP+1000
  173. SEGADJ LSINCP,LLINCP
  174. ENDIF
  175. LISINP(NLIGP1) = LISINC(ILIGRP)
  176. LLSINP(NLIGP1,IMAT)=.TRUE.
  177. ENDIF
  178. 200 CONTINUE
  179. NLIGRD=LISDUA(/2)
  180. IF (ITYPEL.EQ.22) NLIGRD=1
  181. DO 202 ILIGRD=1,NLIGRD
  182. DO ILIGD1=1,NLIGD1
  183. IF (LISDUA(ILIGRD).EQ.LISIND(ILIGD1)) GOTO 202
  184. ENDDO
  185. NLIGD1 = NLIGD1 + 1
  186. IF (NLIGD1.GT.NLIGD) THEN
  187. NLIGD=NLIGD+1000
  188. SEGADJ LSINCD
  189. ENDIF
  190. LISIND(NLIGD1) = LISDUA(ILIGRD)
  191. 202 CONTINUE
  192. SEGDES DESCR
  193. SEGDES MELEME
  194. ENDDO
  195. SEGDES MRIGID
  196. ENDDO
  197. IF (ICHP.NE.0) THEN
  198. MCHPOI=ICHP
  199. SEGACT MCHPOI
  200. NSOUPO=IPCHP(/1)
  201. DO ISOUPO=1,NSOUPO
  202. MSOUPO=IPCHP(ISOUPO)
  203. SEGACT MSOUPO
  204. NC=NOCOMP(/2)
  205. DO 204 IC=1,NC
  206. DO ILIGP1=1,NLIGP1
  207. IF (NOCOMP(IC).EQ.LISINP(ILIGP1)) THEN
  208. LLSINP(ILIGP1,NOBJ)=.TRUE.
  209. GOTO 204
  210. ENDIF
  211. ENDDO
  212. 204 CONTINUE
  213. SEGDES MSOUPO
  214. ENDDO
  215. SEGDES MCHPOI
  216. ENDIF
  217. *
  218. IF (LDBG) THEN
  219. WRITE(IOIMP,*) 'LTYP22=',LTYP22
  220. WRITE(IOIMP,*) 'Liste des inconnues avant compactage'
  221. WRITE(IOIMP,*) ' 1) Duales'
  222. WRITE (IOIMP,2019) (LISIND(I),I=1,NLIGD1)
  223. WRITE(IOIMP,*) ' 2) Primales'
  224. WRITE (IOIMP,2019) (LISINP(I),I=1,NLIGP1)
  225. do j=1,nobj
  226. WRITE(IOIMP,*) ' Presence de la composante primale dans ',
  227. $ 'l''objet ',j
  228. WRITE (IOIMP,2021) (LLSINP(I,j),I=1,NLIGP1)
  229. enddo
  230. ENDIF
  231. * On compacte LSINCD
  232. NLIGD = NLIGD1
  233. SEGADJ LSINCD
  234. * On compacte LSINCP
  235. NLIGP = 0
  236. DO ILIGP1=1,NLIGP1
  237. LOK=.TRUE.
  238. DO IOBJ=1,NOBJ
  239. LOK=LOK.AND.LLSINP(ILIGP1,IOBJ)
  240. ENDDO
  241. IF (LOK) THEN
  242. NLIGP=NLIGP+1
  243. IF (ILIGP1.NE.NLIGP) LISINP(NLIGP)=LISINP(ILIGP1)
  244. ENDIF
  245. ENDDO
  246. SEGADJ LSINCP
  247. SEGSUP LLINCP
  248. IF (LDBG) THEN
  249. WRITE(IOIMP,*) 'Primales apres compactage'
  250. WRITE (IOIMP,2019) (LISINP(I),I=1,LISINP(/2))
  251. ENDIF
  252. * On sort de manière anticipée s'il n'y a pas d'inconnues primales
  253. * communes
  254. IF (NLIGP.EQ.0) THEN
  255. SEGSUP DESCOB,LSINCP,LSINCD
  256. GOTO 9999
  257. ENDIF
  258. *
  259. * Les correspondances locale -> globale dans CORES1 pour les RIGIDITES
  260. *
  261. DO IMAT=1,NMAT
  262. MRIGID=PNTOB(IMAT)
  263. SEGACT MRIGID
  264. NRIGEL=IRIGEL(/2)
  265. SEGINI CORES1
  266. DO I=1,NRIGEL
  267. MELEME = IRIGEL(1,I)
  268. SEGACT MELEME
  269. DESCR = IRIGEL(3,I)
  270. SEGACT DESCR
  271. NLIGRP=LISINC(/2)
  272. NLIGRD=LISDUA(/2)
  273. IF (ITYPEL.EQ.22) NLIGRD=1
  274. SEGINI CORES2
  275. IDEB=1
  276. IF (ITYPEL.EQ.22) IDEB=2
  277. DO 300 ILIGRP=IDEB,NLIGRP
  278. DO ILIGP=1,NLIGP
  279. IF (LISINC(ILIGRP).EQ.LISINP(ILIGP)) THEN
  280. COR2P(ILIGRP)=ILIGP
  281. GOTO 300
  282. ENDIF
  283. ENDDO
  284. COR2P(ILIGRP)=NLIGP+1
  285. 300 CONTINUE
  286. DO 302 ILIGRD=1,NLIGRD
  287. DO ILIGD=1,NLIGD
  288. IF (LISDUA(ILIGRD).EQ.LISIND(ILIGD)) THEN
  289. COR2D(ILIGRD)=ILIGD
  290. GOTO 302
  291. ENDIF
  292. ENDDO
  293. 302 CONTINUE
  294. IPCOR2(I)=CORES2
  295. IF (LDBG) THEN
  296. IF (I.EQ.1.OR.I.EQ.NRIGEL) THEN
  297. WRITE(IOIMP,*)
  298. $ 'Correspondance locale-globale matrice ',imat
  299. $ ,' nrigel=',I
  300. WRITE(IOIMP,*) ' Primales'
  301. WRITE (IOIMP,2019) (LISINC(II),II=1,LISINC(/2))
  302. WRITE (IOIMP,2020) (COR2P(II),II=1,COR2P(/1))
  303. WRITE(IOIMP,*) ' Duales'
  304. WRITE (IOIMP,2019) (LISDUA(II),II=1,LISDUA(/2))
  305. WRITE (IOIMP,2020) (COR2D(II),II=1,COR2D(/1))
  306. ENDIF
  307. ENDIF
  308. ENDDO
  309. PNTCOB(1,IMAT)=CORES1
  310. ENDDO
  311. *
  312. *_______________________________________________________________________
  313. * on remplit maintenant le tableau itopts en bouclant sur les sous zones de
  314. * la rigidité
  315. *
  316. NBPTS = XCOOR(/1) / (IDIM +1)
  317. IF (LDBG) WRITE(IOIMP,*) 'NBPTS=',NBPTS
  318. SEGINI MTOPTS
  319. DO IMAT=1,NMAT
  320. CORES1=PNTCOB(1,IMAT)
  321. MRIGID=PNTOB(IMAT)
  322. NRIGEL=IRIGEL(/2)
  323. DO I=1,NRIGEL
  324. MELEME = IRIGEL(1,I)
  325. DESCR = IRIGEL(3,I)
  326. CORES2 = IPCOR2(I)
  327. NLIGRD = NOELED(/1)
  328. IF (ITYPEL.EQ.22) NLIGRD=1
  329. IDEB=1
  330. IF (ITYPEL.EQ.22) IDEB=2
  331. DO K=1,NUM(/2)
  332. DO J=IDEB,NOELEP(/1)
  333. ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT) =
  334. & ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT)
  335. $ + NLIGRD
  336. ENDDO
  337. ENDDO
  338. ENDDO
  339. ENDDO
  340. NTOPTS=0
  341. IF (ICHP.NE.0) THEN
  342. SEGINI NTOPTS
  343. SEGINI OTOPTS
  344. MCHPOI=ICHP
  345. SEGACT MCHPOI
  346. NSOUPO=IPCHP(/1)
  347. DO ISOUPO=1,NSOUPO
  348. MSOUPO=IPCHP(ISOUPO)
  349. SEGACT MSOUPO
  350. MELEME=IGEOC
  351. SEGACT MELEME
  352. MPOVAL=IPOVAL
  353. SEGACT MPOVAL
  354. NC=NOCOMP(/2)
  355. N=NUM(/2)
  356. DO IC=1,NC
  357. DO ILIGP=1,NLIGP
  358. IF (NOCOMP(IC).EQ.LISINP(ILIGP)) THEN
  359. IDK=ILIGP
  360. GOTO 304
  361. ENDIF
  362. ENDDO
  363. IDK=NLIGP+1
  364. 304 CONTINUE
  365. DO 306 I=1,N
  366. IF (VPOCHA(I,IC).NE.0.D0) THEN
  367. LTOPTS(NUM(1,I),IDK)=.TRUE.
  368. XTOPTS(NUM(1,I),IDK)=VPOCHA(I,IC)
  369. ENDIF
  370. 306 CONTINUE
  371. ENDDO
  372. SEGDES MPOVAL,MELEME,MSOUPO
  373. ENDDO
  374. SEGDES MCHPOI
  375. ELSE
  376. SEGINI OTOPTS
  377. DO ILIGP=1,NLIGP
  378. DO IBPTS=1,NBPTS
  379. LTOPTS(IBPTS,ILIGP)=.TRUE.
  380. ENDDO
  381. ENDDO
  382. ENDIF
  383. IF (LDBG) THEN
  384. npo = MIN(nbpts,100)
  385. WRITE(IOIMP,*) 'Point'
  386. WRITE(IOIMP,2020) (II,II=1,npo)
  387. do imat=1,nmat
  388. do iligp=1,nligp
  389. WRITE(IOIMP,*) ' Matrice ',imat,' inconnue ',LISINP(ILIGP
  390. $ )
  391. WRITE (IOIMP,2020) (ITOPTS(II,iligp,imat),II=1,npo)
  392. enddo
  393. enddo
  394. if (ichp.ne.0) then
  395. do iligp=1,nligp
  396. WRITE(IOIMP,*) ' Chpoint inconnue ',LISINP(ILIGP)
  397. WRITE (IOIMP,2021) (LTOPTS(II,iligp),II=1,npo)
  398. WRITE (IOIMP,2022) (XTOPTS(II,iligp),II=1,npo)
  399. enddo
  400. endif
  401. ENDIF
  402. *
  403. *_______________________________________________________________________
  404. *
  405. * calcul du nombre d'inconnues primales et creation de LESINC
  406. * correspondance entre les inconnues et MCOEF
  407. *
  408. *
  409. DO IMAT=1,NMAT
  410. DO ILIGP=1,NLIGP
  411. DO IBPTS=1,NBPTS
  412. LTOPTS(IBPTS,ILIGP)=LTOPTS(IBPTS,ILIGP)
  413. $ .AND.(ITOPTS(IBPTS,ILIGP,IMAT).NE.0)
  414. ENDDO
  415. ENDDO
  416. ENDDO
  417. NINC=0
  418. DO ILIGP=1,NLIGP
  419. DO IBPTS=1,NBPTS
  420. IF (LTOPTS(IBPTS,ILIGP)) NINC=NINC+1
  421. ENDDO
  422. ENDDO
  423. IF (LDBG) WRITE(IOIMP,*) 'NINC=',NINC
  424. * On sort de manière anticipée s'il n'y a pas d'inconnues primales
  425. * communes
  426. IF (NINC.EQ.0) THEN
  427. SEGSUP OTOPTS,MTOPTS
  428. DO IMAT=1,NMAT
  429. MRIGID=PNTOB(IMAT)
  430. CORES1=PNTCOB(1,IMAT)
  431. NRIGEL=IRIGEL(/2)
  432. DO I=1,NRIGEL
  433. MELEME = IRIGEL(1,I)
  434. DESCR = IRIGEL(3,I)
  435. SEGDES MELEME,DESCR
  436. CORES2=IPCOR2(I)
  437. SEGSUP CORES2
  438. ENDDO
  439. SEGSUP CORES1
  440. SEGDES MRIGID
  441. ENDDO
  442. IF (NTOPTS.NE.0) SEGSUP NTOPTS
  443. SEGSUP DESCOB,LSINCP,LSINCD
  444. GOTO 9999
  445. ENDIF
  446. *
  447. DO IMAT=1,NMAT
  448. DO ILIGP=1,NLIGP
  449. DO IBPTS=1,NBPTS
  450. IF (.NOT.LTOPTS(IBPTS,ILIGP)) THEN
  451. ITOPTS(IBPTS,ILIGP,IMAT)=0
  452. ELSE
  453. ITOPTS(1,NLIGP+1,IMAT)=ITOPTS(1,NLIGP+1,IMAT)
  454. $ +ITOPTS(IBPTS,ILIGP,IMAT)
  455. ENDIF
  456. ENDDO
  457. ENDDO
  458. ENDDO
  459. SEGSUP OTOPTS
  460. IF (LDBG) THEN
  461. do imat=1,nmat
  462. do iligp=1,nligp
  463. WRITE(IOIMP,*) ' Matrice ',imat,' inconnue ',LISINP(ILIGP
  464. $ )
  465. WRITE (IOIMP,2020) (ITOPTS(II,iligp,imat),II=1,npo)
  466. enddo
  467. enddo
  468. ENDIF
  469. *
  470. * on remplit LSINCO et LTINCO en numérotant les ddls dans l'ordre
  471. * où ils sont rencontrés en parcourant la matrice la plus grosse.
  472. * On pourrait les parcourir autrement (dans l'ordre de ITOPTS).
  473. *
  474. IF (NMAT.EQ.2) THEN
  475. NCOEF1=ITOPTS(1,NLIGP+1,1)
  476. NCOEF2=ITOPTS(1,NLIGP+1,2)
  477. IF (NCOEF1.GE.NCOEF2) THEN
  478. IMAT1=1
  479. IMAT2=2
  480. ELSE
  481. IMAT1=2
  482. IMAT2=1
  483. ENDIF
  484. ELSE
  485. NCOEF1=ITOPTS(1,NLIGP+1,1)
  486. NCOEF2=0
  487. IMAT1=1
  488. IMAT2=0
  489. ENDIF
  490. IF (LDBG) THEN
  491. WRITE(IOIMP,*) 'NCOEF1=',NCOEF1
  492. WRITE(IOIMP,*) 'NCOEF2=',NCOEF2
  493. ENDIF
  494. MRIGID=PNTOB(IMAT1)
  495. CORES1=PNTCOB(1,IMAT1)
  496. NRIGEL=IRIGEL(/2)
  497. SEGINI LSINCO
  498. IF (ICHP.NE.0) THEN
  499. SEGINI LTINCO
  500. ELSE
  501. LTINCO=0
  502. ENDIF
  503. IND1 = 1
  504. IDUM1 = 1
  505. IDUM2 = 1
  506. DO 1600 I=1,NRIGEL
  507. MELEME=IRIGEL(1,I)
  508. DESCR=IRIGEL(3,I)
  509. IDEB=1
  510. IF (ITYPEL.EQ.22) IDEB=2
  511. CORES2=IPCOR2(I)
  512. DO 1500 K=1,NUM(/2)
  513. DO 1400 J=IDEB,NOELEP(/1)
  514. IF ( ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1).GT.0) THEN
  515. LESINC(IND1,1,IMAT1)=IDUM1
  516. IDUM1=IDUM1+ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1)
  517. * ITOPTS va desormais contenir le numéro de l'inconnue dans LESINC
  518. ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1) = -1 * IND1
  519. IF(NMAT.EQ.2) THEN
  520. LESINC(IND1,1,IMAT2)=IDUM2
  521. IDUM2=IDUM2+ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT2)
  522. ENDIF
  523. IF (ICHP.NE.0) THEN
  524. XMAS(IND1) = XTOPTS(NUM(NOELEP(J),K),COR2P(J))
  525. ENDIF
  526. IND1 = IND1 + 1
  527. ENDIF
  528. 1400 CONTINUE
  529. 1500 CONTINUE
  530. 1600 CONTINUE
  531. *=====
  532. if ( (IND1-1) .NE. NINC ) then
  533. write(*,*) 'erreur dans boucle lsinco'
  534. endif
  535. *======
  536. LESINC(IND1,1,IMAT1)=IDUM1
  537. IF (NMAT.EQ.2) LESINC(IND1,1,IMAT2)=IDUM2
  538. IF (LDBG) THEN
  539. WRITE(IOIMP,*) 'IDUM1=',IDUM1
  540. WRITE(IOIMP,*) 'IDUM2=',IDUM2
  541. naff=min(ninc,100)
  542. do 2004 k=1,nmat
  543. write(*,*) 'k=',k
  544. do 2002 i=1,naff+1
  545. write(*,2003) i,lesinc(i,1,k),lesinc(i,2,k)
  546. 2002 continue
  547. 2004 continue
  548. ENDIF
  549. *
  550. *_______________________________________________________________________
  551. * remplissage de MCOEF
  552. *
  553. *
  554. DO IMAT=1,NMAT
  555. MRIGID=PNTOB(IMAT)
  556. CORES1=PNTCOB(1,IMAT)
  557. NRIGEL=IRIGEL(/2)
  558. NCOEF=LESINC(NINC+1,1,IMAT)-1
  559. SEGINI MCOEF
  560. DO 1900 I=1,NRIGEL
  561. MELEME = IRIGEL(1,I)
  562. DESCR = IRIGEL(3,I)
  563. CORES2 = IPCOR2(I)
  564. XMATRI = IRIGEL(4,I)
  565. SEGACT XMATRI
  566. IDEB=1
  567. IF (ITYPEL.EQ.22) IDEB=2
  568. NLIGRD=NOELED(/1)
  569. IF (ITYPEL.EQ.22) NLIGRD=1
  570. DO 1800 K=1,NUM(/2)
  571. DO 1700 J=IDEB,NOELEP(/1)
  572. NNINC = -1 * ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1)
  573. IF (NNINC.NE.0) THEN
  574. DO 1650 L=1,NLIGRD
  575. IDMCOE = LESINC(NNINC,1,IMAT)
  576. $ +LESINC(NNINC,2,IMAT)
  577. LESINC(NNINC,2,IMAT) = LESINC(NNINC,2,IMAT) + 1
  578. ICOEF(1,IDMCOE)=NUM(NOELED(L),K)
  579. ICOEF(2,IDMCOE)=COR2D(L)
  580. XCOEF(IDMCOE)=RE(L,J,k)*COERIG(I)
  581. 1650 CONTINUE
  582. ENDIF
  583. 1700 CONTINUE
  584. 1800 CONTINUE
  585. * on referme la boutique
  586. SEGDES XMATRI
  587. SEGSUP CORES2
  588. 1900 CONTINUE
  589. * on referme encore la boutique car meleme et descr
  590. * peuvent être les mêmes pour plusieurs IRIGEL
  591. DO 2000 I=1,NRIGEL
  592. MELEME = IRIGEL(1,I)
  593. DESCR = IRIGEL(3,I)
  594. SEGDES MELEME,DESCR
  595. 2000 CONTINUE
  596. SEGSUP CORES1
  597. SEGDES MRIGID
  598. *
  599. *=====
  600. IF (LDBG) THEN
  601. naff = min(ncoef,100)
  602. do 2005 i=1,naff
  603. write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i)
  604. 2005 continue
  605. ENDIF
  606. *=====
  607. PNTCOB(3,IMAT)=MCOEF
  608. ENDDO
  609. SEGSUP MTOPTS
  610. *------------------------
  611. * Il faut maintenant compacter le MCOEF car le même ddl dual peut
  612. * apparaître plusieurs fois pour une même inconnue primale (ce n'était
  613. * pas le cas anciennement car les ddls duaux étaient des multiplicateurs
  614. * de lagrange supposés uniques (un par relation))
  615. *
  616. IF (LTYP22) GOTO 755
  617. DO IMAT=1,NMAT
  618. MCOEF=PNTCOB(3,IMAT)
  619. DO IINC=1,NINC
  620. IDEB=LESINC(IINC,1,IMAT)
  621. IFIN=IDEB+LESINC(IINC,2,IMAT)-1
  622. DO I=IDEB,IFIN
  623. IC1=ICOEF(1,I)
  624. IC2=ICOEF(2,I)
  625. IF (IC1.NE.0) THEN
  626. DO J=I+1,IFIN
  627. JC1=ICOEF(1,J)
  628. JC2=ICOEF(2,J)
  629. IF (JC1.EQ.IC1.AND.JC2.EQ.IC2) THEN
  630. XCOEF(I)=XCOEF(I)+XCOEF(J)
  631. ICOEF(1,J)=0
  632. ENDIF
  633. ENDDO
  634. ENDIF
  635. ENDDO
  636. ENDDO
  637. *=====
  638. IF (LDBG) THEN
  639. WRITE(IOIMP,*) 'COMPACTAGE 1'
  640. naff = min(ncoef,100)
  641. do i=1,naff
  642. write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i)
  643. enddo
  644. ENDIF
  645. *=====
  646. IDECG=0
  647. IDEB=LESINC(1,1,IMAT)
  648. DO IINC=1,NINC
  649. IFIN=IDEB+LESINC(IINC,2,IMAT)-1
  650. IDECL=0
  651. DO I=IDEB,IFIN
  652. IF (ICOEF(1,I).EQ.0) THEN
  653. IDECL=IDECL+1
  654. ELSE
  655. ICOEF(1,I-IDECG-IDECL)=ICOEF(1,I)
  656. ICOEF(2,I-IDECG-IDECL)=ICOEF(2,I)
  657. XCOEF(I-IDECG-IDECL)=XCOEF(I)
  658. ENDIF
  659. ENDDO
  660. LESINC(IINC,2,IMAT)=LESINC(IINC,2,IMAT)-IDECL
  661. IDEB=LESINC(IINC+1,1,IMAT)
  662. IDECG=IDECG+IDECL
  663. LESINC(IINC+1,1,IMAT)=LESINC(IINC+1,1,IMAT)-IDECG
  664. ENDDO
  665. NCOEF=LESINC(NINC+1,1,IMAT)-1
  666. SEGADJ MCOEF
  667. IF (LDBG) THEN
  668. WRITE(IOIMP,*) 'NCOEF=',NCOEF
  669. WRITE(IOIMP,*) 'COMPACTAGE 2'
  670. naff=min(ninc,100)
  671. do i=1,naff+1
  672. k=imat
  673. write(*,2003) i,lesinc(i,1,k),lesinc(i,2,k)
  674. enddo
  675. naff = min(ncoef,100)
  676. do i=1,naff
  677. write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i)
  678. enddo
  679. ENDIF
  680. ENDDO
  681. 755 CONTINUE
  682. *_______________________________________________________________________
  683. *
  684. * il ne reste plus qu' a creer les matrices élémentaires
  685. *
  686. NOER = .TRUE.
  687. * Construction des noms d'inconnues primales correspondant à LISIND
  688. NLIGD=LISIND(/2)
  689. SEGINI CORIDP
  690. DO ILIGD=1,NLIGD
  691. CALL PLACE(NOMDU,LNOMDU,idx,LISIND(ILIGD))
  692. IF (idx.EQ.0) THEN
  693. LISIDP(ILIGD)=LISIND(ILIGD)
  694. ELSE
  695. LISIDP(ILIGD)=NOMDD(idx)
  696. ENDIF
  697. ENDDO
  698. *
  699. * il y a autant de matrices élémentaires qu'il y a de coefficients
  700. *
  701. NRIGEL=NINC
  702. SEGINI MRIGID
  703. IRIG2 = MRIGID
  704. MTYMAT='CMCT '
  705. *
  706. * boucle sur les sous zones
  707. *
  708. DO 700 I=1,NRIGEL
  709. * GRXDUM = 0.D0
  710. * PTXDUM = 9.D50
  711. COERIG(I) = 1.D0
  712. NBNN=0
  713. IDXDUA=0
  714. *
  715. * S'il y a deux rigidités à multiplier, on stocke la primale
  716. * puis la duale dans le MELEME et dans XDUM. A ce moment-là,
  717. * IDXDUA+1 est l'index de départ des noeuds et des valeurs de la duale.
  718. * On parcourt donc DESCOB à l'envers car on avait d'abord mis
  719. * la duale C avant la primale B
  720. *
  721. DO IMAT=NMAT,1,-1
  722. NBNN=NBNN+LESINC(I,2,IMAT)
  723. IF (IDXDUA.EQ.0.AND.NMAT.EQ.2) IDXDUA=NBNN
  724. ENDDO
  725. * creation du maillage et du vecteur des coefficients
  726. NBELEM = 1
  727. NBSOUS = 0
  728. NBREF = 0
  729. SEGINI WORK1
  730. SEGINI MELEME
  731. INOEU = 0
  732. DO IMAT=NMAT,1,-1
  733. MCOEF=PNTCOB(3,IMAT)
  734. DO 1200 J=0,LESINC(I,2,IMAT)-1
  735. INOEU = INOEU + 1
  736. NUM(INOEU,1) = ICOEF(1,J+LESINC(I,1,IMAT))
  737. XDUM(INOEU) = XCOEF(J+LESINC(I,1,IMAT))
  738. * GRXDUM=MAX(GRXDUM,ABS(XDUM(INOEU)))
  739. * IF (XDUM(INOEU).NE.0.D0) THEN
  740. * PTXDUM=MIN(PTXDUM,ABS(XDUM(INOEU)))
  741. * ENDIF
  742. 1200 CONTINUE
  743. *
  744. * petit controle sur le conditionnement de la matrice
  745. * il n'est pas forcément pertinent
  746. *
  747. * IF (((PTXDUM/GRXDUM).LT.1.D-12).AND.NOER) THEN
  748. * CALL ERREUR(-320)
  749. * NOER = .FALSE.
  750. * ENDIF
  751. ENDDO
  752. ITYPEL = 28
  753. IRIGEL(1,I) = MELEME
  754. *
  755. * segment descripteur DESCR
  756. *
  757. NLIGRP=NBNN
  758. IF (NMAT.EQ.1) THEN
  759. NLIGRP = NBNN
  760. NLIGRD = NBNN
  761. ELSE
  762. NLIGRP = IDXDUA
  763. NLIGRD = NBNN-IDXDUA
  764. ENDIF
  765. SEGINI DESCR
  766. IPASS=0
  767. DO IMAT=NMAT,1,-1
  768. MCOEF=PNTCOB(3,IMAT)
  769. IPASS=IPASS+1
  770. INOEU=0
  771. DO 1300 J=0,LESINC(I,2,IMAT)-1
  772. INOEU = INOEU + 1
  773. IF (IPASS.EQ.1) THEN
  774. LISINC(INOEU) = LISIDP(ICOEF(2,J+LESINC(I,1,IMAT)))
  775. NOELEP(INOEU)=INOEU
  776. IF (NMAT.EQ.1) THEN
  777. LISDUA(INOEU) = LISIND(ICOEF(2,J+LESINC(I,1,IMAT)))
  778. NOELED(INOEU)=INOEU
  779. ENDIF
  780. ENDIF
  781. IF (IPASS.EQ.2) THEN
  782. LISDUA(INOEU)
  783. $ = LISIND(ICOEF(2,J+LESINC(I,1,IMAT)))
  784. NOELED(INOEU)=IDXDUA+INOEU
  785. ENDIF
  786. 1300 CONTINUE
  787. ENDDO
  788. IRIGEL(3,I) = DESCR
  789. *
  790. * la matrice elle meme
  791. *
  792. IF (ICHP.NE.0) THEN
  793. XCOEF=XMAS(I)
  794. ELSE
  795. XCOEF=1.D0
  796. ENDIF
  797. NELRIG = 1
  798. SEGINI XMATRI
  799. IRIGEL(4,I)=XMATRI
  800. DO 600 J=1,NLIGRP
  801. DO 500 K=1,NLIGRD
  802. RE(K,J,1)=XDUM(IDXDUA+K)*XDUM(J)*XCOEF
  803. 500 CONTINUE
  804. 600 CONTINUE
  805. *
  806. SEGDES DESCR
  807. SEGSUP WORK1
  808. SEGDES MELEME
  809. * S'il y a deux matrices en entrée, le résultat
  810. * n'est sans doute pas symétrique
  811. IF (NMAT.EQ.2) then
  812. IRIGEL(7,I)=2
  813. xmatri.symre=2
  814. endif
  815. SEGDES XMATRI
  816. 700 CONTINUE
  817. SEGDES MRIGID
  818. *
  819. * Ménage
  820. *
  821.  
  822. DO IMAT=1,NMAT
  823. MCOEF=PNTCOB(3,IMAT)
  824. SEGSUP MCOEF
  825. ENDDO
  826. SEGSUP LSINCO
  827. IF (LTINCO.NE.0) SEGSUP LTINCO
  828. SEGSUP CORIDP
  829. SEGSUP LSINCP
  830. RETURN
  831. *
  832. * Rigidité vide si pas de ddls primaux communs entre les
  833. * objets d'entrée
  834. *
  835. 9999 CONTINUE
  836. NRIGEL=0
  837. SEGINI MRIGID
  838. MTYMAT='CMCT '
  839. SEGDES MRIGID
  840. IRIG2=MRIGID
  841. *
  842. 2003 format(I4,1X,I4,1X,I4,2X,E12.5)
  843. 2019 FORMAT (20(2X,A4) )
  844. 2020 FORMAT (20(2X,I4) )
  845. 2021 FORMAT (20(2X,L4) )
  846. 2022 FORMAT(10(1X,1PG12.5))
  847. *_______________________________________________________________________
  848. RETURN
  849. END
  850.  
  851.  
  852.  
  853.  
  854.  
  855.  
  856.  
  857.  
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  

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