Télécharger rela2.eso

Retour à la liste

Numérotation des lignes :

  1. C RELA2 SOURCE BP208322 17/04/18 21:15:13 9395
  2. SUBROUTINE RELA2(LEMOT)
  3. ************************************************************************
  4. * cet operateur impose des mouvements de corps rigide
  5. * ou l accrochage de deux maillages
  6. *
  7. * syntaxe :
  8. * rig1 = rela | cori depl (rota) |
  9. * | | geo1 (geo2)
  10. * | ense ux uy uz ut rx ry rz rt |
  11. *
  12. * cori = mot cle
  13. * ense = mot cle
  14. * depl = pour imposer que la distance entre les points
  15. * reste constante
  16. * rota = pour imposer que tous les points ont les memes
  17. * rotations
  18. * ux = pour imposer que la valeur sur la composante ux
  19. * est la meme pour tous les points
  20. * geo1 = objet de type meleme ou point
  21. * geo2 = objet de type meleme
  22. * rig1 = objet de type rigidite
  23. *
  24. * accrochage syntaxe :
  25. * rig1 = RELA geo1 ACCR geo2 ; ( geo2 massif )
  26. *
  27. ************************************************************************
  28.  
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8 (A-H,O-Z)
  31. -INC CCOPTIO
  32. -INC CCGEOME
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMRIGID
  36. -INC CCHAMP
  37. c
  38. SEGMENT MOTDDV
  39. CHARACTER*4 MOTDDL(0)
  40. ENDSEGMENT
  41. SEGMENT NOMINV
  42. CHARACTER*4 NOMINC(0)
  43. ENDSEGMENT
  44. SEGMENT NUMAIT(NBMAIT)
  45. SEGMENT NUESCL(NBESCL)
  46. c
  47. CHARACTER*4 ITCORI(3),LEMOT
  48. CHARACTER*4 MOACCR(2)
  49. CHARACTER*4 MODEPL(6),MODEDU(6)
  50. CHARACTER*8 CTYP
  51. DIMENSION COEF(3)
  52. c
  53. DATA ITCORI(1)/'DEPL'/
  54. DATA ITCORI(2)/'ROTA'/
  55. DATA ITCORI(3)/'NOVE'/
  56. DATA MODEPL(1)/'UX '/
  57. DATA MODEPL(2)/'UY '/
  58. DATA MODEPL(3)/'UZ '/
  59. DATA MODEPL(4)/'UR '/
  60. DATA MODEPL(5)/'UZ '/
  61. DATA MODEPL(6)/'UT '/
  62. DATA MODEDU(1)/'FX '/
  63. DATA MODEDU(2)/'FY '/
  64. DATA MODEDU(3)/'FZ '/
  65. DATA MODEDU(4)/'FR '/
  66. DATA MODEDU(5)/'FZ '/
  67. DATA MODEDU(6)/'FT '/
  68. DATA MOACCR(1)/'FORT'/
  69. DATA MOACCR(2)/'FAIB'/
  70. c
  71. DATA ZERO,UNO /0.D0,1.D0/
  72.  
  73.  
  74. * on teste la compatibilité des données ******************************
  75. * en fourier le mouvement de corps rigide n'a pas toujours de sens
  76. cbp IF ( LEMOT.NE.'ENSE') THEN
  77. IF ( LEMOT.EQ.'CORI') THEN
  78. * cette remarque ne vaut que pour l'option cori
  79. IF (((IDIM.EQ.3).AND.(IFOMOD.NE.2)).OR.
  80. + ((IDIM.EQ.2).AND. (IFOMOD.EQ.2)).OR.
  81. + ((IFOUR.EQ.1).AND.( ABS(NIFOUR).GT.1))) THEN
  82. CALL ERREUR(21)
  83. RETURN
  84. ENDIF
  85. ENDIF
  86. c
  87. c on cherche a lire les directions ***********************************
  88. SEGINI MOTDDV,NOMINV
  89. IDEPL=0
  90. IROTA=0
  91. IENSE=0
  92. JVER=1
  93.  
  94. c
  95. IF(IFOUR.NE.-2.AND.IFOUR.NE.-1.AND.IFOUR.NE.-3)GOTO 101
  96. c
  97. c deformations planes ou contraintes planes ou def. planes generalisées
  98. LDEPL=2
  99. IADEPL=0
  100. IAROTA=2
  101. GOTO 107
  102.  
  103. 101 CONTINUE
  104. IF(IFOUR.NE.1) GOTO 103
  105. c
  106. c fourier
  107. LDEPL=3
  108. IADEPL=3
  109. IAROTA=2
  110. GOTO 107
  111.  
  112. 103 CONTINUE
  113. IF(IFOUR.NE.2) GOTO 107
  114. c
  115. c tridim
  116. LDEPL=3
  117. IADEPL=0
  118. IAROTA=0
  119.  
  120. 107 CONTINUE
  121.  
  122. C option ACCRO ou GLIS *********************************************
  123. IF(LEMOT.EQ.'ACCR'.OR.LEMOT.EQ.'GLIS') THEN
  124. igli=0
  125. iaccr=0
  126. if (LEMOT.EQ.'GLIS' ) then
  127. igli=1
  128. else
  129. * ACCRO : lecture facultative du mot clé FORT ou FAIBLE
  130. CALL LIRMOT(MOACCR,2,iaccr,0)
  131. endif
  132. if (iaccr.eq.0) then
  133. c RELA GLIS ou RELA ACCRO => ACCRO
  134. CALL ACCRO (igli)
  135. elseif (iaccr.eq.1) then
  136. c RELA ACCRO 'FORT' => ACCRO3
  137. CALL ACCRO3
  138. elseif (iaccr.eq.2) then
  139. c RELA ACCRO 'FAIBL' => ACCRO2
  140. CALL ACCRO2
  141. else
  142. c Option indisponible
  143. call erreur(19)
  144. endif
  145. RETURN
  146. ENDIF
  147.  
  148. c option ENSE ******************************************************
  149. IF(LEMOT.EQ.'ENSE') THEN
  150.  
  151. IENSE = 1
  152. 445 CONTINUE
  153. CALL LIRMOT(NOMDD,LNOMDD,IMOT,0)
  154. IF(IMOT.EQ.0) GO TO 446
  155. MOTDDL(**)=NOMDD(IMOT)
  156. MOTDDL(**)=NOMDU(IMOT)
  157. GO TO 445
  158. 446 CONTINUE
  159. IBDDL=MOTDDL(/2)
  160.  
  161. c option CORI ******************************************************
  162. ELSE IF(LEMOT.EQ.'CORI') THEN
  163.  
  164. cccccccc a t on une directive depl
  165. c
  166. IOBL=1
  167. 4480 CONTINUE
  168. CALL LIRMOT(ITCORI,3,IMOT,IOBL)
  169. IF(IERR.NE.0) RETURN
  170. IF(IMOT.EQ.0) GOTO 448
  171. IOBL=0
  172. GO TO (44801,44802,44803),IMOT
  173. 44801 continue
  174. c
  175. cccccccccccc on a trouve le mot deplacement
  176. c
  177. IDEPL=1
  178. DO 4481 IA=1,LDEPL
  179. NOMINC(**)=MODEPL(IADEPL+IA)
  180. NOMINC(**)=MODEDU(IADEPL+IA)
  181. 4481 CONTINUE
  182. GO TO 4480
  183. 44802 continue
  184. c
  185. cccccccc on a trouve le mot rotation
  186. c
  187. IROTA=1
  188. GO TO 4480
  189. 44803 continue
  190. JVER=0
  191. GO TO 4480
  192. 448 CONTINUE
  193.  
  194. ENDIF
  195. c endif des options ENSE et CORI ***********************************
  196.  
  197. c
  198. c on cherche a lire le(s) maillage(s) ******************************
  199. c
  200. * cas de mot clé rota ou fourier 0 ou axis 0
  201. IF ((IDEPL.EQ.1).AND.((IROTA.EQ.1).OR.
  202. + (NIFOUR.EQ.0 .AND. IFOMOD.EQ.1).OR.(IFOMOD.EQ.0))) THEN
  203. CALL QUETYP(CTYP,1,IRETOU)
  204. IF (IRETOU.EQ.0) GOTO 555
  205. IF(CTYP.EQ.'MAILLAGE') THEN
  206. CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  207. IF (IRETOU.EQ.0) GOTO 555
  208. LP=0
  209. * on regarde si on a donné juste un point
  210. ELSE IF (CTYP.EQ.'POINT ') THEN
  211. CALL LIROBJ('POINT ',KOBJET,1,IRETOU)
  212. IF (IRETOU.EQ.0) GOTO 555
  213. LP=1
  214. ELSE
  215. GOTO 555
  216. ENDIF
  217. CALL LIROBJ('MAILLAGE',KOBJE2,0,IRETOU)
  218. IF((IRETOU.EQ.0).AND.(LP.EQ.1)) THEN
  219. CALL ERREUR(26)
  220. GOTO 555
  221. ENDIF
  222. CALL RELA3 (KOBJET,KOBJE2,LP,IROTA)
  223. GOTO 555
  224. ELSE
  225. * cas sans mot clé rota (sauf fourier 0 et axis 0)
  226. CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  227. IF(IRETOU.EQ .0) GOTO 555
  228. ENDIF
  229.  
  230. MELEME=KOBJET
  231. SEGACT MELEME
  232. IF(ITYPEL .NE.1) CALL CHANGE(MELEME,1)
  233. NBPOIN=NUM(/2)
  234. c
  235. c dans le cas depl on ecrit que la distance entre les points reste
  236. c constante ,1 matrice avec
  237. c en 2d , 3 noeuds maitres et 2(n-3)+3 relations
  238. c en 3d , 4 noeuds maitres et 3(n-4)+6 relations
  239. c on prend comme noeuds maitres possibles
  240. c les 3 premiers noeuds non alignes en 2d
  241. c les 4 premiers noeuds non coplanaires en 3d
  242. c
  243. IF (IDEPL.EQ.1) THEN
  244. IF (IDIM.EQ.2) NBMAIT=3
  245. IF (IDIM.EQ.3) NBMAIT=4
  246. c erreur nb de pts du maillage inferieur au nb de noeuds maitres
  247. IF (NBPOIN.LT.NBMAIT.AND.JVER.EQ.1) THEN
  248. CALL ERREUR(364)
  249. GOTO 998
  250. ENDIF
  251. IF(JVER.EQ.1) THEN
  252. NBESCL=NBPOIN-NBMAIT
  253. SEGINI NUMAIT,NUESCL
  254. cc cas 2d determination des 3 noeuds maitres
  255. IF (IDIM.EQ.2) THEN
  256. IP1=NUM(1,1)
  257. IP2=NUM(1,2)
  258. IREFP1=(IP1-1)*(IDIM+1)
  259. IREFP2=(IP2-1)*(IDIM+1)
  260. X12=XCOOR(IREFP2+1)-XCOOR(IREFP1+1)
  261. Y12=XCOOR(IREFP2+2)-XCOOR(IREFP1+2)
  262. P12N=SQRT(X12**2+Y12**2)
  263. DO 300 I=3,NBPOIN
  264. IP3=NUM(1,I)
  265. IREFP3=(IP3-1)*(IDIM+1)
  266. X13=XCOOR(IREFP3+1)-XCOOR(IREFP1+1)
  267. Y13=XCOOR(IREFP3+2)-XCOOR(IREFP1+2)
  268. P13N=SQRT(X13**2+Y13**2)
  269. TEST=X12*X13+Y12*Y13
  270. IF(ABS(TEST).GT.0.9997D0*(P12N*P13N)) GOTO 300
  271. GOTO 399
  272. 300 continue
  273. 310 continue
  274. cccc erreur tous les points sont alignes ou quasiment
  275. CALL ERREUR(362)
  276. GOTO 999
  277. cc cas 3d determination des 4 noeuds maitres
  278. ELSE IF (IDIM.EQ.3) THEN
  279. IP1=NUM(1,1)
  280. IP2=NUM(1,2)
  281. IREFP1=(IP1-1)*(IDIM+1)
  282. IREFP2=(IP2-1)*(IDIM+1)
  283. X12=XCOOR(IREFP2+1)-XCOOR(IREFP1+1)
  284. Y12=XCOOR(IREFP2+2)-XCOOR(IREFP1+2)
  285. Z12=XCOOR(IREFP2+3)-XCOOR(IREFP1+3)
  286. P12N=SQRT(X12**2+Y12**2+Z12**2)
  287. DO 350 I=3,NBPOIN
  288. IP3=NUM(1,I)
  289. IREFP3=(IP3-1)*(IDIM+1)
  290. X13=XCOOR(IREFP3+1)-XCOOR(IREFP1+1)
  291. Y13=XCOOR(IREFP3+2)-XCOOR(IREFP1+2)
  292. Z13=XCOOR(IREFP3+3)-XCOOR(IREFP1+3)
  293. P13N=SQRT(X13**2+Y13**2+Z13**2)
  294. TEST=X12*X13+Y12*Y13+Z12*Z13
  295. IF(ABS(TEST).GT.0.9997D0*(P12N*P13N)) GOTO 350
  296. GOTO 360
  297. 350 continue
  298. GOTO 380
  299. 360 continue
  300. XN=Y12*Z13-Z12*Y13
  301. YN=Z12*X13-X12*Z13
  302. ZN=X12*Y13-Y12*X13
  303. PN=XN**2+YN**2+ZN**2
  304. DO 370 I=3,NBPOIN
  305. IP4=NUM(1,I)
  306. IREFP4=(IP4-1)*(IDIM+1)
  307. X14=XCOOR(IREFP4+1)-XCOOR(IREFP1+1)
  308. Y14=XCOOR(IREFP4+2)-XCOOR(IREFP1+2)
  309. Z14=XCOOR(IREFP4+3)-XCOOR(IREFP1+3)
  310. P14N=SQRT(X14**2+Y14**2+Z14**2)
  311. TEST=XN*X14+YN*Y14+ZN*Z14
  312. IF(ABS(TEST).LT.0.025D0*(PN*P14N)) GOTO 370
  313. GOTO 399
  314. 370 continue
  315. 380 continue
  316. cccc erreur tous les points sont coplanaires ou quasiment
  317. CALL ERREUR(363)
  318. GOTO 999
  319. ENDIF
  320. 399 continue
  321. NUMAIT(1)=IP1
  322. NUMAIT(2)=IP2
  323. NUMAIT(3)=IP3
  324. IF (IDIM.EQ.3) NUMAIT(4)=IP4
  325. I1=0
  326. DO 397 I=3,NBPOIN
  327. DO 398 J=1,NBMAIT
  328. IF(NUM(1,I).EQ.NUMAIT(J)) GOTO 397
  329. 398 continue
  330. I1=I1+1
  331. NUESCL(I1)=NUM(1,I)
  332. 397 continue
  333. ELSEIF(JVER.EQ.0) THEN
  334. NBESCL=NBPOIN-NBMAIT
  335. IF(NBESCL.GT.0) THEN
  336. SEGINI NUMAIT,NUESCL
  337. ELSE
  338. NBMAIT=NBPOIN
  339. NBESCL=0
  340. SEGINI NUMAIT
  341. ENDIF
  342. DO 396 I=1,NBMAIT
  343. NUMAIT(I)=NUM(1,I)
  344. 396 CONTINUE
  345. IF(NBESCL.GT.0) THEN
  346. DO 395 I=1,NBESCL
  347. NUESCL(I)=NUM(1,I+NBMAIT)
  348. 395 CONTINUE
  349. ENDIF
  350. ENDIF
  351. ENDIF
  352. c
  353. c dans le cas ense ,on ecrit que la valeur sur un ddl
  354. c donne est la meme pour tous les points ,ibddl/2 matrices avec
  355. c (n-1) relations
  356. c
  357. IF(IENSE.EQ.1) NNMAT=IBDDL/2
  358. IF(IDEPL.EQ.1) THEN
  359. NNMAT=1
  360. * en fourier 1 on a en plus que ur=-ut a tout point et une relation d'analogie
  361. * sur uz entre deux noeuds (p.ex. 2 noeuds maitres)
  362. IF(ABS(NIFOUR).EQ.1) NNMAT=3
  363. ENDIF
  364. IF(NNMAT.EQ.0) GO TO 555
  365. NRIGE=7
  366. NRIGEL=NNMAT
  367. SEGINI MRIGID
  368. ICHOLE=0
  369. IMGEO1=0
  370. IMGEO2=0
  371. ISUPEQ=0
  372. IFORIG=IFOMOD
  373. MTYMAT='RIGIDITE'
  374. KRIGI=MRIGID
  375. c
  376. cccc on rajoute les noeuds associes aux multiplicateurs au maillage
  377. c
  378. cc segact mcoord
  379. ccccccccc nombre de noeuds
  380. NBNO=XCOOR(/1)/(IDIM+1)
  381. NBNOI=NBNO
  382. IF(IENSE.EQ.1) NBPTS=NBNO+NNMAT*(NBPOIN-1)
  383. IF(IDEPL.EQ.1) THEN
  384. IF(IDIM.EQ.2) NBPTS=NBNO+(2*(NBPOIN-3)+3)
  385. IF(IDIM.EQ.3) NBPTS=NBNO+(3*(NBPOIN-4)+6)
  386. IF(NBPOIN.EQ.2) NBPTS=NBNO +1
  387. IF(ABS(NIFOUR).EQ.1)NBPTS = NBPTS + NBPOIN + 1
  388. ENDIF
  389. SEGADJ MCOORD
  390. c
  391. cccc boucle sur les rigidites elementaires
  392. c si idepl=1 et irota=1 la 1ere rigidite elementaire est associee a
  393. c l option depl et les suivantes a l option rota
  394. c
  395.  
  396. IF (IENSE.EQ.1) NBRELA=NBPOIN-1
  397. I7=0
  398. DO 7 IAA=1,NNMAT
  399. IF (IDEPL.EQ.1) THEN
  400. IF (IAA.EQ.1) THEN
  401. IF(IDIM.EQ.2) NBRELA=2*(NBPOIN-3)+3
  402. IF(IDIM.EQ.3) NBRELA=3*(NBPOIN-4)+6
  403. IF(NBPOIN.EQ.2) NBRELA=1
  404. ELSE IF (IAA.eq.2) THEN
  405. * fourier 1 ur=-ut
  406. NBRELA=NBPOIN
  407. * fourier 1 relation d'analogie sur uz
  408. ELSE IF (IAA.eq.3) THEN
  409. nbrela = 1
  410. ENDIF
  411. ENDIF
  412. * print*,'idepl=',idepl
  413. * print*,'iaa=',iaa
  414. cccccccc on cree le noeud nbno+1 et nbno+2
  415. cccccccc on les met a l origine
  416. DO 5 IA=1,NBRELA
  417. XCOOR(NBNOI*(IDIM+1)+1)=0.D0
  418. XCOOR(NBNOI*(IDIM+1)+2)=0.D0
  419. IF (IDIM.EQ.3) XCOOR(NBNOI*(IDIM+1)+3)=0.D0
  420. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=0.D0
  421. NBNOI=NBNOI+1
  422. 5 CONTINUE
  423. c
  424. c on initialise le segment meleme associe aux blocages
  425. c
  426. NBSOUS=0
  427. NBREF=0
  428. NBNN=3
  429. NBELEM=NBRELA
  430. SEGINI IPT1
  431. IRIGEL(1,IAA)=IPT1
  432. IPT1.ITYPEL=22
  433. DO 400 I4=1,NBRELA
  434. IPT1.ICOLOR(I4)=IDCOUL
  435. c punti associati ai moltiplicatori
  436. IPT1.NUM(1,I4)=NBNO+I7+1
  437. I7=I7+1
  438. 400 continue
  439. c caricamento nodi pseudo-elementi
  440. * option ensemble
  441. IF (IENSE.EQ.1) THEN
  442. DO 420 I9=1,NBRELA
  443. IPT1.NUM(2,I9)=NUM(1,I9)
  444. IPT1.NUM(3,I9)=NUM(1,I9+1)
  445. 420 continue
  446. * fourier 1 ur = -ut
  447. ELSE IF (IDEPL.EQ.1.AND.IAA.EQ.2) THEN
  448. DO 421 I9=1,NBRELA
  449. IPT1.NUM(2,I9)=NUM(1,I9)
  450. IPT1.NUM(3,I9)=NUM(1,I9)
  451. 421 continue
  452. ELSE IF (IDEPL.EQ.1.AND.IAA.EQ.1) THEN
  453. I9=0
  454. IF(NBPOIN.GT.NBMAIT) THEN
  455. c pseudo-elements pour les relations des autres noeuds avec
  456. c les noeuds maitres
  457. DO 430 IC=1, NBESCL
  458. ICOREC = 0
  459. DO 431 IB=1,NBMAIT-1
  460. I9=I9+1
  461. IPT1.NUM(3,I9)=NUESCL(IC)
  462. IPT1.NUM(2,I9)=NUMAIT(IB)
  463. * on teste si le noeud esclave est colineaire avec les 2 maitres
  464. IF (IB.EQ.2) THEN
  465. IREFES = (NUESCL(IC)-1)*(IDIM+1)
  466. XX13=XCOOR(IREFES+1)-XCOOR(IREFP1+1)
  467. YY13=XCOOR(IREFES+2)-XCOOR(IREFP1+2)
  468. PP13N=SQRT(XX13**2+YY13**2)
  469. TTEST=X12*XX13+Y12*YY13
  470. IF (IDIM.EQ.3) THEN
  471. ZZ13 = XCOOR(IREFES+3)-XCOOR(IREFP1+3)
  472. PP13N=PP13N+ZZ13**2
  473. TTEST=TTEST+Z12*ZZ13
  474. ENDIF
  475. IF(ABS(TTEST).GT.0.9997D0*(P12N*PP13N)) THEN
  476. IPT1.NUM(2,I9)=NUMAIT(IB+1)
  477. ICOREC = 1
  478. ENDIF
  479. ELSE IF (IB.EQ.3) THEN
  480. IF (ICOREC.EQ.1) THEN
  481. IPT1.NUM(2,I9)=NUMAIT(IB+1)
  482. * on teste si le noeud esclave est coplanaire avec les 3 maitres
  483. ELSE
  484. TTEST=XN*XX13+YN*YY13+ZN*ZZ13
  485. IF(ABS(TTEST).LT.0.025D0*(P12N*P13N))IPT1.NUM(2,I9)=NUMAIT(IB+1)
  486. ENDIF
  487. ENDIF
  488. 431 continue
  489. 430 continue
  490. ENDIF
  491. c pseudo-elements pour les relations entre les noeuds maitres
  492. DO 432 IB=2,NBMAIT
  493. I9=I9+1
  494. IPT1.NUM(2,I9)=NUMAIT(1)
  495. IPT1.NUM(3,I9)=NUMAIT(IB)
  496. 432 continue
  497. IF(NBMAIT.GE.3) THEN
  498. DO 433 IB=3,NBMAIT
  499. I9=I9+1
  500. IPT1.NUM(2,I9)=NUMAIT(2)
  501. IPT1.NUM(3,I9)=NUMAIT(IB)
  502. 433 continue
  503. ENDIF
  504. IF (NBMAIT.GE.4) THEN
  505. DO 434 IB=4,NBMAIT
  506. I9=I9+1
  507. IPT1.NUM(2,I9)=NUMAIT(3)
  508. IPT1.NUM(3,I9)=NUMAIT(IB)
  509. 434 continue
  510. ENDIF
  511. ENDIF
  512. * fourier 1, relation d'analogie sur uz
  513. * on cherche les 2 noeuds maitres avec xmax et xmin
  514. * pour etre sur de ne pas avoir choisi 2 noeuds ayan la
  515. * meme coordonnee x
  516. if ((idepl.eq.1).and.(iaa.eq.3)) then
  517. xx = xcoor(irefp1+1)
  518. x1 = xx
  519. ipp1 = ip1
  520. if (xcoor(irefp2+1).gt.xx) then
  521. x1 =xcoor(irefp2+1)
  522. ipp1 = ip2
  523. else if (xcoor(irefp3+1).gt.xx) then
  524. x1 =xcoor(irefp3+1)
  525. ipp1 = ip3
  526. endif
  527. x2 = xx
  528. ipp2 =ip1
  529. if (xcoor(irefp2+1).lt.xx) then
  530. x2 =xcoor(irefp2+1)
  531. ipp2 = ip2
  532. else if (xcoor(irefp3+1).lt.xx) then
  533. x2 =xcoor(irefp3+1)
  534. ipp2 = ip3
  535. endif
  536. ipt1.num(2,1)=ipp2
  537. ipt1.num(3,1)=ipp1
  538. endif
  539. * correction on place les pts mult au barycentre des noeuds associes
  540. * a chaque relation
  541. DO 425 IA=1,NBRELA
  542. IREF1=(IPT1.NUM(1,IA)-1)*(IDIM+1)
  543. IREF2=(IPT1.NUM(2,IA)-1)*(IDIM+1)
  544. IREF3=(IPT1.NUM(3,IA)-1)*(IDIM+1)
  545. XCOOR(IREF1+1)=(XCOOR(IREF2+1)+XCOOR(IREF3+1))/2
  546. XCOOR(IREF1+2)=(XCOOR(IREF2+2)+XCOOR(IREF3+2))/2
  547. IF(IDIM.EQ.3) XCOOR(IREF1+3)=(XCOOR(IREF2+3)+XCOOR(IREF3+3))/2
  548. 425 CONTINUE
  549. cccccccc on vient de crer les segment meleme resultat
  550. cccccccc on va creer les raideurs
  551. IRIGEL(2,IAA)=0
  552. IRIGEL(5,IAA)=NIFOUR
  553. IRIGEL(6,IAA)=0
  554. IRIGEL(7,IAA)=0
  555. IF(IENSE.EQ.1.OR.IAA.GT.1) NLIGRE=3
  556. IF(IDEPL.EQ.1.AND.IAA.EQ.1) NLIGRE=2*IDIM+1
  557. NLIGRP=NLIGRE
  558. NLIGRD=NLIGRE
  559. SEGINI DESCR
  560. IRIGEL(3,IAA)=DESCR
  561. c on remplit le tableau des descripteurs de rig
  562.  
  563. LISINC(1)='LX'
  564. LISDUA(1)='FLX'
  565. NOELEP(1)=1
  566. NOELED(1)=1
  567. IF(IENSE.EQ.1) THEN
  568. JAA=2*(IAA-1)
  569. LISINC(2)=MOTDDL(JAA+1)
  570. LISINC(3)=LISINC(2)
  571. LISDUA(2)=MOTDDL(JAA+2)
  572. LISDUA(3)=LISDUA(2)
  573. NOELEP(2)=2
  574. NOELEP(3)=3
  575. NOELED(2)=2
  576. NOELED(3)=3
  577. ELSE IF (IDEPL.EQ.1.AND.IAA.EQ.1) THEN
  578. DO 250 I=1,IDIM
  579. JAA=2*(I-1)
  580. J=1+2*(I-1)
  581. LISINC(J+1)=NOMINC(JAA+1)
  582. LISINC(J+2)=LISINC(J+1)
  583. LISDUA(J+1)=NOMINC(JAA+2)
  584. LISDUA(J+2)=LISDUA(J+1)
  585. NOELEP(J+1)=2
  586. NOELEP(J+2)=3
  587. NOELED(J+1)=2
  588. NOELED(J+2)=3
  589. 250 continue
  590.  
  591. * fourier 1 ur = -ut
  592. ELSE IF (IDEPL.EQ.1.AND.IAA.EQ.2) THEN
  593. LISINC(2)=MODEPL(4)
  594. LISINC(3)=MODEPL(6)
  595. LISDUA(2)=MODEDU(4)
  596. LISDUA(3)=MODEDU(6)
  597. NOELEP(2)=2
  598. NOELEP(3)=3
  599. NOELED(2)=2
  600. NOELED(3)=3
  601. ELSE IF (IDEPL.EQ.1.AND.IAA.EQ.3) THEN
  602. LISINC(2)=MODEPL(3)
  603. LISINC(3)=MODEPL(3)
  604. LISDUA(2)=MODEDU(3)
  605. LISDUA(3)=MODEDU(3)
  606. NOELEP(2)=2
  607. NOELEP(3)=3
  608. NOELED(2)=2
  609. NOELED(3)=3
  610. ENDIF
  611. SEGDES DESCR
  612. c
  613. NELRIG=NBRELA
  614. SEGINI xMATRI
  615. IRIGEL(4,IAA)=xMATRI
  616. COERIG(IAA)=1.D0
  617. c
  618. c remplissage de RE
  619.  
  620. IF (IENSE.EQ.1.OR.IAA.GT.1) THEN
  621. do iou=1,nelrig
  622. * SEGINI XMATRI
  623. * IXMATR=XMATRI
  624. RE(1,1,iou)= 0.D0
  625. RE(2,1,iou)= 1.D0
  626. IF (IENSE.EQ.1) THEN
  627. RE(3,1,iou)= -1.D0
  628. * ur = - ut
  629. ELSE IF (IAA.EQ.2) THEN
  630. RE(3,1,iou)= 1.D0
  631. * analogie sur uz en fourier 1
  632. ELSE
  633. RE(3,1,iou)= -x2/x1
  634. ENDIF
  635. DO 777 I=1,1
  636. DO 666 J=2,NLIGRE
  637. RE(I,J,iou)=RE(J,I,iou)
  638. 666 CONTINUE
  639. 777 CONTINUE
  640. enddo
  641. * SEGDES XMATRI
  642. * DO 3 IA=1,NELRIG
  643. * IMATTT(IA)=IXMATR
  644. * 3 CONTINUE
  645. ELSE IF (IDEPL.EQ.1.AND.IAA.EQ.1) THEN
  646. DO 740 IA=1,NELRIG
  647. DO 741 I=1,IDIM
  648. IREF2=(IPT1.NUM(2,IA)-1)*(IDIM+1)
  649. IREF3=(IPT1.NUM(3,IA)-1)*(IDIM+1)
  650. COEF(I)=XCOOR(IREF2+I)-XCOOR(IREF3+I)
  651. 741 continue
  652. * SEGINI XMATRI
  653. * IMATTT(IA)=XMATRI
  654. RE(1,1,ia)= 0.D0
  655.  
  656. DO 760 I1=2,NLIGRE
  657. I4=INT(I1/2)
  658. COEF1=COEF(I4)
  659. IF((2*I4).LT.I1) COEF1=-COEF(I4)
  660. DO 760 I2=1,1
  661. RE(I1,I2,ia)=COEF1
  662. RE(I2,I1,ia)=COEF1
  663. 760 continue
  664. * SEGDES XMATRI
  665. 740 continue
  666. ENDIF
  667. SEGDES xMATRI
  668. c
  669. SEGDES IPT1
  670. 7 CONTINUE
  671.  
  672. c
  673. SEGDES MRIGID
  674. CALL ECROBJ('RIGIDITE',KRIGI)
  675. 999 continue
  676. IF (IDEPL.EQ.1) THEN
  677. SEGSUP NUMAIT
  678. IF(NBESCL.GT.0) SEGSUP NUESCL
  679. ENDIF
  680. 998 continue
  681. SEGDES MELEME
  682. 555 CONTINUE
  683. SEGSUP MOTDDV,NOMINV
  684. RETURN
  685. END
  686.  
  687.  
  688.  
  689.  
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  
  696.  

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