Télécharger rela3.eso

Retour à la liste

Numérotation des lignes :

  1. C RELA3 SOURCE BP208322 16/11/18 21:20:52 9177
  2. SUBROUTINE RELA3(IPC,IPM,LP,IROTA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. *****************************************************************
  6. *
  7. * relation de corps rigide en cas des coques ou des poutres
  8. * eventuellement en combinaison avec des massifs
  9. *
  10. * entrées
  11. * IPC : pointeur sur le maillage (ou numero du point) ayant des
  12. * ddl de rotation naturellement (poutres ou coques)
  13. *
  14. * IPM : pointeur sur le maillage n'ayant pas des ddl de rotation
  15. * naturellement (massif)
  16. *
  17. * LP : 0 --> IPC est un maillage
  18. * 1 --> IPC est un point
  19. *
  20. * IROTA : 1 les rotaions de IPC sont de ddl du problème
  21. * 0 les rotaions de IPC ne sont pas de ddl du problème
  22. * (on s'en sert pour traiter le cas fourier 0 et axis
  23. * en l'absence du mot clé ROTA)
  24. *
  25. * on écrit dans la pile la rigidité KRIGI
  26. *
  27. * I. Politopoulos 09/05/95
  28. ****************************************************************
  29. -INC CCOPTIO
  30. -INC CCGEOME
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMRIGID
  34. -INC CCHAMP
  35.  
  36. CHARACTER*4 MODEPL(5),MODEDU(5)
  37. CHARACTER*4 MORODU(4),MOROTA(4)
  38.  
  39. DATA MODEPL(1)/'UX '/
  40. DATA MODEPL(2)/'UY '/
  41. DATA MODEPL(3)/'UZ '/
  42. DATA MODEPL(4)/'UR '/
  43. DATA MODEPL(5)/'UT '/
  44. DATA MODEDU(1)/'FX '/
  45. DATA MODEDU(2)/'FY '/
  46. DATA MODEDU(3)/'FZ '/
  47. DATA MODEDU(4)/'FR '/
  48. DATA MODEDU(5)/'FT '/
  49. DATA MOROTA(1)/'RX '/
  50. DATA MOROTA(2)/'RY '/
  51. DATA MOROTA(3)/'RZ '/
  52. DATA MOROTA(4)/'RT '/
  53. DATA MORODU(1)/'MX '/
  54. DATA MORODU(2)/'MY '/
  55. DATA MORODU(3)/'MZ '/
  56. DATA MORODU(4)/'MT '/
  57.  
  58.  
  59.  
  60. * activation du maillage avec des ddl de rotation
  61. * et definition du noeud maitre
  62.  
  63. IF (LP.EQ.0) THEN
  64. MELEME=IPC
  65. SEGACT MELEME
  66. IF(ITYPEL .NE.1) CALL CHANGE(MELEME,1)
  67. NBPOIC=NUM(/2)
  68. IP1 = NUM(1,1)
  69. * si 1 seul point
  70. ELSE
  71. IP1 = IPC
  72. NBPOIC = 1
  73. ENDIF
  74. * activation du maillage massif
  75. IF (IPM .NE. 0) THEN
  76. IPT2 = IPM
  77. SEGACT IPT2
  78. IF(IPT2.ITYPEL .NE.1) CALL CHANGE(IPT2,1)
  79. NBPOIM = IPT2.NUM(/2)
  80. ELSE
  81. NBPOIM = 0
  82. ENDIF
  83.  
  84. NBTOT = NBPOIC + NBPOIM
  85.  
  86. * nombre de noeuds
  87. cc SEGACT MCOORD
  88. NBNO = XCOOR(/1)/(IDIM+1)
  89.  
  90. ** definition du noeud maitre en cas fourier 0 pour
  91. ** la relation sur UT car il ne peut pas etre sur l'axe.
  92. ** Pour ne pas mettre un critere absolu on choisit le point
  93. ** le plus lointain
  94. IF ((IFOUR .EQ. 1) .AND. (NIFOUR.EQ.0)) THEN
  95. XMAX = 0.D0
  96. DO 8 I=1,NUM(/2)
  97. IPP1 = NUM(1,I)
  98. IREF1 = (IPP1-1)*(IDIM+1)
  99. XI1 = XCOOR(IREF1+1)
  100. IF(ABS(XI1).GT.XMAX) THEN
  101. XMAX = ABS(XI1)
  102. NUM(1,I)=IP1
  103. IP1 = IPP1
  104. NUM(1,1)=IP1
  105. ENDIF
  106. 8 CONTINUE
  107. ENDIF
  108. * quelques dimensions pour l'initialisation du maillage des relations
  109. NBSOUS = 0
  110. NBREF = 0
  111. NBNN = 3
  112. * coordonnees du point maitre
  113. IREFP1 = (IP1-1)*(IDIM+1)
  114. X1 = XCOOR(IREFP1+1)
  115. Y1 = XCOOR(IREFP1+2)
  116.  
  117. IF((IFOMOD.EQ.0).OR.((IFOMOD.EQ.1).AND.(NIFOUR.EQ.0)))
  118. + GOTO 100
  119.  
  120. c
  121. ccc debut 3D ou (2d plan cont ou defo) ou (fourier 1)
  122. c
  123. IF (IDIM .EQ.3) THEN
  124. Z1 = XCOOR(IREFP1+3)
  125. * nombre de types de matrices et nombre de relations
  126. L1 = 3
  127. L2 = 3
  128. NNMAT = 6
  129. NBRELA = (NBPOIC-1)*6 + NBPOIM*3
  130. ENDIF
  131. IF (IDIM.EQ.2) THEN
  132. IF (IFOMOD.EQ.-1) THEN
  133. L1 = 1
  134. L2 = 2
  135. NNMAT = 3
  136. NBRELA = (NBPOIC-1)*3 + NBPOIM*2
  137. * fourier 1, -1. il faut imposer en plus que ur = -ut
  138. ELSE IF (ABS(NIFOUR).EQ.1) THEN
  139. L1 = 1
  140. L2 = 3
  141. NNMAT = 4
  142. * + 2 car le nombre des relations ur=-ut et entre rt et uz est
  143. * egal au nombre des points
  144. NBRELA = (NBPOIC-1)*4 + NBPOIM*3 + 2
  145. ENDIF
  146. ENDIF
  147. IF (NBPOIC .EQ.1) THEN
  148. IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) THEN
  149. NNMAT = IDIM
  150. ELSE IF (ABS(NIFOUR).EQ.1) THEN
  151. NNMAT = 3
  152. ENDIF
  153. ENDIF
  154.  
  155. * on ajuste MCOORD pour les noeuds associes aux multiplicateurs
  156. NBPTS = NBNO + NBRELA
  157. NBNOI = NBNO
  158. SEGADJ MCOORD
  159. * initialisation du segment mrigid
  160. NRIGE=7
  161. NRIGEL=NNMAT
  162. SEGINI MRIGID
  163. ICHOLE=0
  164. IMGEO1=0
  165. IMGEO2=0
  166. ISUPEQ=0
  167. IFORIG=IFOMOD
  168. MTYMAT='RIGIDITE'
  169. KRIGI=MRIGID
  170. * relations sur les rotations
  171. IND = 0
  172. IF (NBPOIC.GT.1) THEN
  173. NELRIG = (NBPOIC-1)
  174. NLIGRE = 3
  175. NLIGRP = NLIGRE
  176. NLIGRD = NLIGRE
  177. * SEGINI IMATRI
  178. SEGINI XMATRI
  179. IXMATR=XMATRI
  180. * DO 5 I=1,NELRIG
  181. * IMATTT(I) = IXMATR
  182. * 5 CONTINUE
  183. * on remplit les valeurs RE de la matrice pour les rotations
  184. RE(1,1,1)= 0.D0
  185. RE(2,1,1)= 1.D0
  186. RE(3,1,1)= -1.D0
  187. RE(2,2,1)= 0.D0
  188. RE(3,2,1)= 0.D0
  189. RE(3,3,1)= 0.D0
  190. * on definit explicitement les termes symetriques car on a constaté
  191. * des petites differences aux resultats si on le fait pas
  192. RE(1,2,1)= RE(2,1,1)
  193. RE(1,3,1)= RE(3,1,1)
  194. RE(2,3,1)= RE(3,2,1)
  195. do ioup=2,nelrig
  196. do io=1,re(/2)
  197. do iu=1,re(/1)
  198. re(iu,io,ioup)=re(iu,io,1)
  199. enddo
  200. enddo
  201. enddo
  202. SEGDES XMATRI
  203. * SEGDES IMATRI
  204. * boucle sur les differents types de matrices
  205. DO 10 IAA= 1,L1
  206. IRIGEL(2,IAA) = 0
  207. IRIGEL(5,IAA) = NIFOUR
  208. IRIGEL(6,IAA) = 0
  209. IRIGEL(7,IAA) = 0
  210. IRIGEL(4,IAA) = xMATRI
  211. COERIG(IAA) =1.D0
  212. * initialisation du segment melem associé aux blocages
  213. NBELEM = NBPOIC-1
  214. SEGINI IPT1
  215. IRIGEL(1,IAA) = IPT1
  216. IPT1.ITYPEL = 22
  217. * on remplit le tableau des descripteurs
  218. SEGINI DESCR
  219. IRIGEL(3,IAA)=DESCR
  220. LISINC(1)='LX'
  221. LISDUA(1)='FLX'
  222. NOELEP(1)=1
  223. NOELED(1)=1
  224. IF (IDIM.EQ.3) THEN
  225. LISINC(2)= MOROTA(IAA)
  226. LISINC(3)= MOROTA(IAA)
  227. LISDUA(2)= MORODU(IAA)
  228. LISDUA(3)= MORODU(IAA)
  229. ELSE IF (IFOMOD.EQ.-1) THEN
  230. LISINC(2)= MOROTA(3)
  231. LISINC(3)= MOROTA(3)
  232. LISDUA(2)= MORODU(3)
  233. LISDUA(3)= MORODU(3)
  234. ELSE IF (ABS(NIFOUR).EQ.1) THEN
  235. LISINC(2)= MOROTA(4)
  236. LISINC(3)= MOROTA(4)
  237. LISDUA(2)= MORODU(4)
  238. LISDUA(3)= MORODU(4)
  239. ENDIF
  240. NOELEP(2)=2
  241. NOELEP(3)=3
  242. NOELED(2)=2
  243. NOELED(3)=3
  244. SEGDES DESCR
  245. * boucle sur les points du maillage ayant des ddl de rotation
  246. DO 20 II=1,NBELEM
  247. IP2 = NUM(1,(II+1))
  248. IREFP2 = (IP2-1)*(IDIM+1)
  249. X2 = XCOOR(IREFP2+1)
  250. Y2 = XCOOR(IREFP2+2)
  251. IF (IDIM.EQ.3) Z2 = XCOOR(IREFP2+3)
  252. IPT1.ICOLOR(II) = IDCOUL
  253. * points associés aux multiplicateurs
  254. IPT1.NUM(1,II) = NBNOI + 1
  255. IREFM1 = NBNOI*(IDIM+1)
  256. NBNOI = NBNOI + 1
  257. IPT1.NUM(2,II) = IP1
  258. IPT1.NUM(3,II) = IP2
  259. XCOOR(IREFM1+1) = (X1 + X2)/2
  260. XCOOR(IREFM1+2) = (Y1 + Y2)/2
  261. IF (IDIM.EQ.3) THEN
  262. XCOOR(IREFM1+3) = (Z1 + Z2)/2
  263. ENDIF
  264. 20 CONTINUE
  265. SEGDES IPT1
  266. IND = IAA
  267. 10 CONTINUE
  268. ENDIF
  269.  
  270. * fin de relations sur les rotations on passe
  271. * aux relations entre le noeud maitre et les depl. des autres noeuds
  272. IF (IDIM.EQ.3) NLIGRE = 5
  273. IF (IDIM.EQ.2) NLIGRE = 4
  274. NLIGRP = NLIGRE
  275. NLIGRD = NLIGRE
  276. NELRIG = (NBTOT-1)
  277. NBELEM = NBTOT-1
  278. * boucle sur les differents types de matrices
  279. DO 40 IAAA= 1,L2
  280. IAA = IND + IAAA
  281. * relations entre rt et uz et ur = -ut en fourier 1
  282. IF((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)) then
  283. nligre = 3
  284. nligrp = nligre
  285. nligrd = nligre
  286. NELRIG = NBTOT
  287. NBELEM = NBTOT
  288. ENDIF
  289. * initialisation du segment melem associé aux blocages
  290. SEGINI IPT1
  291. IPT1.ITYPEL = 22
  292. *
  293. IRIGEL(1,IAA) = IPT1
  294. IRIGEL(2,IAA) = 0
  295. IRIGEL(5,IAA) = NIFOUR
  296. IRIGEL(6,IAA) = 0
  297. IRIGEL(7,IAA) = 0
  298. SEGINI xMATRI
  299. IRIGEL(4,IAA) = xMATRI
  300. COERIG(IAA) =1.D0
  301. * on remplit le tableau des descripteurs
  302. SEGINI DESCR
  303. IRIGEL(3,IAA)=DESCR
  304. LISINC(1)='LX'
  305. LISDUA(1)='FLX'
  306. NOELEP(1)=1
  307. NOELED(1)=1
  308.  
  309. NOELEP(2)=3
  310. NOELEP(3)=2
  311. NOELED(2)=3
  312. NOELED(3)=2
  313. IF (.NOT.((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)))THEN
  314. NOELEP(4)=2
  315. NOELED(4)=2
  316. endif
  317. IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) kk = 4
  318. IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) KK = IAAA
  319. LISINC(2)= MODEPL(KK)
  320. LISINC(3)= MODEPL(KK)
  321. LISDUA(2)= MODEDU(KK)
  322. LISDUA(3)= MODEDU(KK)
  323. * relation entre rt et uz en fourier 1
  324. IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.2)) then
  325. LISINC(2)= MODEPL(3)
  326. LISINC(3)= MOROTA(4)
  327. LISDUA(2)= MODEDU(3)
  328. LISDUA(3)= MORODU(4)
  329. endif
  330. * relation entre ur et ut en fourier 1
  331. if ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.3)) then
  332. LISINC(2)= MODEPL(4)
  333. LISINC(3)= MODEPL(5)
  334. LISDUA(2)= MODEDU(4)
  335. LISDUA(3)= MODEDU(5)
  336. ENDIF
  337.  
  338. IF (IDIM.EQ.3) THEN
  339. IF (IAAA.EQ.1) THEN
  340. LISINC(4)= MOROTA(2)
  341. LISINC(5)= MOROTA(3)
  342. LISDUA(4)= MORODU(2)
  343. LISDUA(5)= MORODU(3)
  344. ELSE IF (IAAA.EQ.2) THEN
  345. LISINC(4)= MOROTA(3)
  346. LISINC(5)= MOROTA(1)
  347. LISDUA(4)= MORODU(3)
  348. LISDUA(5)= MORODU(1)
  349. ELSE
  350. LISINC(4)= MOROTA(1)
  351. LISINC(5)= MOROTA(2)
  352. LISDUA(4)= MORODU(1)
  353. LISDUA(5)= MORODU(2)
  354. ENDIF
  355. NOELEP(5)=2
  356. NOELED(5)=2
  357. * cont. ou defo planes
  358. ELSE IF (IFOMOD.EQ.-1) THEN
  359. LISINC(4)= MOROTA(3)
  360. LISDUA(4)= MORODU(3)
  361. * fourier 1 ou -1
  362. ELSE IF ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.1)) THEN
  363. LISINC(4)= MOROTA(4)
  364. LISDUA(4)= MORODU(4)
  365. ENDIF
  366.  
  367. SEGDES DESCR
  368.  
  369. * boucle sur les points du maillage total
  370. DO 50 II=1,NBELEM
  371. IF(NBELEM.NE.NBTOT) THEN
  372. * partie coques ou poutres
  373. IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1))
  374. * partie massif
  375. IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1))
  376. ELSE
  377. * fourier 1 ou -1, relation ur = -ut et relation entre rt et uz
  378. IF (II.LE.NBPOIC) IP2 = NUM(1,II)
  379. IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC))
  380. ENDIF
  381. IREFP2 = (IP2-1)*(IDIM+1)
  382. X2 = XCOOR(IREFP2+1)
  383. Y2 = XCOOR(IREFP2+2)
  384. IF (IDIM.EQ.3) Z2 = XCOOR(IREFP2+3)
  385. IPT1.ICOLOR(II) = IDCOUL
  386. * points associés aux multiplicateurs
  387. IPT1.NUM(1,II) = NBNOI + 1
  388. IREFM1 = NBNOI*(IDIM+1)
  389. NBNOI = NBNOI + 1
  390. IF((ABS(NIFOUR).EQ.1).AND.(IAAA.EQ.3)) THEN
  391. IP1 = IP2
  392. X1 = X2
  393. Y1 = Y2
  394. ENDIF
  395. IPT1.NUM(2,II) = IP1
  396. IPT1.NUM(3,II) = IP2
  397. XCOOR(IREFM1+1) = (X1 + X2)/2
  398. XCOOR(IREFM1+2) = (Y1 + Y2)/2
  399. IF (IDIM.EQ.3) THEN
  400. XCOOR(IREFM1+3) = (Z1 + Z2)/2
  401. ENDIF
  402. * on remplit les valeurs RE de la matrice
  403. * SEGINI XMATRI
  404. * IXMATR = XMATRI
  405. * IMATTT(II) = IXMATR
  406.  
  407. IF (IAAA.EQ.1) THEN
  408. COEF1 = Z2-Z1
  409. COEF2 = Y2-Y1
  410. ELSE IF (IAAA.EQ.2) THEN
  411. COEF1 = X2-X1
  412. COEF2 = Z2-Z1
  413. ELSE
  414. COEF1 = Y2-Y1
  415. COEF2 = X2-X1
  416. ENDIF
  417.  
  418. RE(1,1,ii)= 0.D0
  419. RE(2,1,ii)= 1.D0
  420. RE(3,1,ii)= -1.D0
  421. if (abs(nifour).eq.1) then
  422. * relation entre uz et rt en fourier 1
  423. if (iaaa.eq.2) then
  424. re(3,1,ii) = -x2
  425. endif
  426. * relation ur = -ut en fourier 1
  427. if (iaaa.eq.3) then
  428. RE(3,1,ii)= 1.D0
  429. endif
  430. ENDIF
  431. IF (IDIM.EQ.3) THEN
  432. RE(4,1,ii)= -1.D0*COEF1
  433. RE(5,1,ii)= 1.D0*COEF2
  434. ELSE IF (IFOMOD.EQ.-1) THEN
  435. IF (IAAA.EQ.1) THEN
  436. RE(4,1,ii)= 1.D0*COEF2
  437. ELSE
  438. RE(4,1,ii)= -1.D0*COEF1
  439. ENDIF
  440. ELSE IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) then
  441. * relation entre ur1, ur2 et rt1 en fourier 1
  442. * le signe ne respecte pas le triedre orthonorme de fourier mais
  443. * celui des calculs plans. Ce n'est pas tres elegant mais c'est
  444. * comme ca dans C2000 !!!!
  445. RE(4,1,ii)= 1.D0*COEF2
  446. ENDIF
  447.  
  448. DO 7 I=1,1
  449. DO 6 J=2,NLIGRE
  450. RE(I,J,ii)=RE(J,I,ii)
  451. 6 CONTINUE
  452. 7 CONTINUE
  453.  
  454. DO 3 I=2,NLIGRE
  455. DO 4 J=2,NLIGRE
  456. RE(I,J,ii)=0.D0
  457. 4 CONTINUE
  458. 3 CONTINUE
  459.  
  460. * SEGDES XMATRI
  461. 50 CONTINUE
  462. SEGDES xMATRI
  463. SEGDES IPT1
  464. 40 CONTINUE
  465. GOTO 1000
  466.  
  467. *
  468. *** fin 3D ou (2d plan cont ou defo) ou (fourier 1)
  469. *
  470.  
  471. 100 CONTINUE
  472. *
  473. *** fourier 0 ou axis
  474. *
  475. NBNN = 2
  476.  
  477. IF (IFOMOD.EQ.0) THEN
  478. * axis : UR=0 RT=0 UZ = cte
  479. L2 = 2
  480. NNMAT = 3
  481. NBRELA = NBPOIC*3 + NBPOIM*2 - 1
  482. * cas sans rotation
  483. if (irota.eq.0) then
  484. nnmat = 2
  485. nbrela = nbpoic*2 -1
  486. endif
  487. ELSE
  488. * fourier 0 : UR=0 RT=0 UZ = cte relation d'analogie sur UT
  489. L2 = 3
  490. NNMAT = 4
  491. NBRELA = NBPOIC*4 + NBPOIM*3 - 2
  492. * cas sans rotation
  493. if (irota.eq.0) then
  494. nnmat = 3
  495. nbrela = nbpoic*3 -2
  496. endif
  497. ENDIF
  498. * on ajuste MCOORD pour les noeuds associes aux multiplicateurs
  499. NBPTS = NBNO + NBRELA
  500. NBNOI = NBNO
  501. SEGADJ MCOORD
  502. * initialisation du segment mrigid
  503. NRIGE=7
  504. NRIGEL=NNMAT
  505. SEGINI MRIGID
  506. ICHOLE=0
  507. IMGEO1=0
  508. IMGEO2=0
  509. ISUPEQ=0
  510. IFORIG=IFOMOD
  511. MTYMAT='RIGIDITE'
  512. KRIGI=MRIGID
  513. if (irota.eq.0) goto 121
  514. * rotation RT = 0
  515. NELRIG = NBPOIC
  516. NLIGRE = 2
  517. NLIGRP = NLIGRE
  518. NLIGRD = NLIGRE
  519. * SEGINI IMATRI
  520. SEGINI XMATRI
  521. * IXMATR=XMATRI
  522. * DO 105 I=1,NELRIG
  523. * IMATTT(I) = IXMATR
  524. * 105 CONTINUE
  525. * on remplit les valeurs RE de la matrice pour les rotations
  526. RE(1,1,1)= 0.D0
  527. RE(2,1,1)= 1.D0
  528. RE(2,2,1)= 0.D0
  529. RE(1,2,1)= RE(2,1,1)
  530. do ioup=2,nelrig
  531. do io=1,re(/2)
  532. do iu=1,re(/1)
  533. re(iu,io,ioup)=re(iu,io,1)
  534. enddo
  535. enddo
  536. enddo
  537. * SEGDES XMATRI
  538. SEGDES xMATRI
  539.  
  540. IRIGEL(2,1) = 0
  541. IRIGEL(5,1) = NIFOUR
  542. IRIGEL(6,1) = 0
  543. IRIGEL(7,1) = 0
  544. IRIGEL(4,1) = xMATRI
  545. COERIG(1) =1.D0
  546. * initialisation du segment melem associé aux blocages
  547. NBELEM = NBPOIC
  548. SEGINI IPT1
  549. IRIGEL(1,1) = IPT1
  550. IPT1.ITYPEL = 22
  551. * on remplit le tableau des descripteurs
  552. SEGINI DESCR
  553. IRIGEL(3,1)=DESCR
  554. LISINC(1)='LX'
  555. LISDUA(1)='FLX'
  556. LISINC(2)= MOROTA(4)
  557. LISDUA(2)= MORODU(4)
  558. NOELEP(1)=1
  559. NOELED(1)=1
  560. NOELEP(2)=2
  561. NOELED(2)=2
  562. SEGDES DESCR
  563. * boucle sur les points du maillage ayant des ddl de rotation
  564. DO 120 II=1,NBELEM
  565. IP2 = NUM(1,II)
  566. IREFP2 = (IP2-1)*(IDIM+1)
  567. X2 = XCOOR(IREFP2+1)
  568. Y2 = XCOOR(IREFP2+2)
  569. IPT1.ICOLOR(II) = IDCOUL
  570. * points associés aux multiplicateurs
  571. IPT1.NUM(1,II) = NBNOI + 1
  572. IREFM1 = NBNOI*(IDIM+1)
  573. NBNOI = NBNOI + 1
  574. IPT1.NUM(2,II) = IP2
  575. XCOOR(IREFM1+1) = X2
  576. XCOOR(IREFM1+2) = Y2
  577. 120 CONTINUE
  578. SEGDES IPT1
  579. 121 continue
  580.  
  581. * fin de relations sur la rotation on passe aux relations
  582. * sur les déplacements
  583. DO 140 IAAA= 1,L2
  584. IAA = 1 + IAAA
  585. if (irota.eq.0) iaa = iaaa
  586. IF (IAAA.EQ.1) THEN
  587. NLIGRE = 2
  588. NBELEM = NBTOT
  589. ELSE
  590. NLIGRE =3
  591. NBELEM = NBTOT-1
  592. NBNN = 3
  593. ENDIF
  594. NLIGRP = NLIGRE
  595. NLIGRD = NLIGRE
  596. NELRIG = NBELEM
  597. * initialisation du segment melem associé aux blocages
  598. SEGINI IPT1
  599. IPT1.ITYPEL = 22
  600. IRIGEL(1,IAA) = IPT1
  601. IRIGEL(2,IAA) = 0
  602. IRIGEL(5,IAA) = NIFOUR
  603. IRIGEL(6,IAA) = 0
  604. IRIGEL(7,IAA) = 0
  605. SEGINI xMATRI
  606.  
  607.  
  608. IRIGEL(4,IAA) = xMATRI
  609. COERIG(IAA) =1.D0
  610. * on remplit le tableau des descripteurs
  611. SEGINI DESCR
  612. IRIGEL(3,IAA)=DESCR
  613. LISINC(1)='LX'
  614. LISDUA(1)='FLX'
  615. NOELEP(1)=1
  616. NOELED(1)=1
  617. NOELEP(2)=2
  618. NOELED(2)=2
  619. IF(IAAA.EQ.1) THEN
  620. LISINC(2) = MODEPL(4)
  621. LISDUA(2) = MODEDU(4)
  622. ELSE
  623. NOELEP(3)=4
  624. NOELED(3)=4
  625. IF(IAAA.EQ.2) THEN
  626. LISINC(2) = MODEPL(3)
  627. LISDUA(2) = MODEDU(3)
  628. LISINC(3) = MODEPL(3)
  629. LISDUA(3) = MODEDU(3)
  630. ELSE
  631. LISINC(2) = MODEPL(5)
  632. LISDUA(2) = MODEDU(5)
  633. LISINC(3) = MODEPL(5)
  634. LISDUA(3) = MODEDU(5)
  635. ENDIF
  636. ENDIF
  637. SEGDES DESCR
  638. DO 150 II=1,NBELEM
  639. IF(IAAA.GT.1) THEN
  640. IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1))
  641. IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1))
  642. ELSE
  643. IF (II.LE.NBPOIC) IP2 = NUM(1,II)
  644. IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC))
  645. ENDIF
  646. IREFP2 = (IP2-1)*(IDIM+1)
  647. X2 = XCOOR(IREFP2+1)
  648. Y2 = XCOOR(IREFP2+2)
  649. IPT1.ICOLOR(II) = IDCOUL
  650. * points associés aux multiplicateurs
  651. IPT1.NUM(1,II) = NBNOI + 1
  652. IREFM1 = NBNOI*(IDIM+1)
  653. NBNOI = NBNOI + 1
  654. IPT1.NUM(3,II) = IP2
  655. IF(IAAA.GT.1) THEN
  656. IPT1.NUM(4,II) = IP1
  657. XCOOR(IREFM1+1) = (X1 + X2)/2
  658. XCOOR(IREFM1+2) = (Y1 + Y2)/2
  659. ELSE
  660. XCOOR(IREFM1+1) = X2
  661. XCOOR(IREFM1+2) = Y2
  662. ENDIF
  663.  
  664. * on remplit les valeurs RE de la matrice
  665.  
  666. * SEGINI XMATRI
  667. * IXMATR = XMATRI
  668. IF(IAAA.EQ.1) THEN
  669. RE(1,1,ii)= 0.D0
  670. RE(2,1,ii)= 1.D0
  671. RE(2,2,ii)= 0.D0
  672. RE(1,2,ii)= RE(2,1,ii)
  673. RE(1,2,ii)= RE(3,1,ii)
  674. ELSE
  675. RE(1,1,ii)= 0.D0
  676. RE(2,1,ii)= 1.D0
  677. IF (IAAA.EQ.2) THEN
  678. RE(3,1,ii)= -1.D0
  679. ELSE
  680. COEF1 = X2/X1
  681. RE(3,1,ii)= -1.D0*COEF1
  682. ENDIF
  683. RE(2,2,ii)= 0.D0
  684. RE(3,2,ii)= 0.D0
  685. RE(3,3,ii)= 0.D0
  686. RE(1,2,ii)= RE(2,1,ii)
  687. RE(1,3,ii)= RE(3,1,ii)
  688. RE(2,3,ii)= RE(3,2,ii)
  689. ENDIF
  690.  
  691. * SEGDES XMATRI
  692. * IMATTT(II) = IXMATR
  693. 150 CONTINUE
  694. SEGDES xMATRI
  695. SEGDES IPT1
  696. 140 CONTINUE
  697.  
  698. 1000 CONTINUE
  699. SEGDES MRIGID
  700. CALL ECROBJ('RIGIDITE', KRIGI)
  701. IF (LP.EQ.0) SEGDES MELEME
  702. IF (IPM.NE.0) SEGDES IPT2
  703. RETURN
  704. END
  705.  
  706.  
  707.  
  708.  
  709.  
  710.  

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