Télécharger ricabl.eso

Retour à la liste

Numérotation des lignes :

  1. C RICABL SOURCE CHAT 09/10/09 21:23:08 6519
  2. SUBROUTINE RICABL
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC SMELEME
  7. -INC SMRIGID
  8. -INC SMCOORD
  9. SEGMENT ITRA
  10. REAL*8 COR(6),XK(6,6),C(3),D(3),E(3)
  11. ENDSEGMENT
  12. CHARACTER*4 MOTU(3),MOTF(3)
  13. DATA MOTU/'UX ','UY ','UZ '/,MOTF/'FX ','FY ','FZ '/
  14. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  15. IF(IERR.NE.0) RETURN
  16. CALL LIRREE(XVAL,1,IRETOU)
  17. IF(IERR.NE.0) RETURN
  18. FE=XVAL
  19. CALL LIRREE(XVAL,1,IRETOU)
  20. IF(IERR.NE.0) RETURN
  21. EPS=XVAL
  22. IF(XVAL.LE.0.) CALL ERREUR(368)
  23. IF(IERR.NE.0) RETURN
  24. SEGACT MELEME
  25. IF(LISOUS(/1).NE.0) CALL ERREUR (369)
  26. IF(IERR.NE.0) RETURN
  27. IF(ITYPEL.NE.2)CALL ERREUR (369)
  28. IF(IERR.NE.0) RETURN
  29. NRIGE=8
  30. NRIGEL=idim +1
  31. SEGINI MRIGID
  32. C
  33. C *** CREATION D'UN NOUVEAU MELEME A 2 POINTS POUR Y APPUYER LA
  34. C *** RIGIDITE PROPRE AU CABLE.ON CALCULE LA RIGIDITE AU FUR ET A
  35. C *** MESURE .ON CREE UN NOUVEAU NOEUD A LA MEME
  36. C *** PLACE QUE LE DEUXIEME ET ON METTRA EN RELATION UNILATERALES
  37. C *** CES DEUX NOEUDS CONFONDUS
  38. C
  39. IFORIG=IFOMOD
  40. IRIGEL(5,1)=NIFOUR
  41. IRIGEL(5,2)=NIFOUR
  42. MTYMAT='RIGIDITE'
  43. COERIG(1)=1.D0
  44. COERIG(2)=1.D0
  45. COERIG(3)=1.D0
  46. if(idim.eq.3)COERIG(4)=1.D0
  47. NBNN=2
  48. NBELEM=NUM(/2)
  49. NLIGRP = IDIM*2
  50. NLIGRD = IDIM*2
  51. SEGINI DESCR
  52. NELRIG=NBELEM
  53. SEGINI xMATRI
  54. NBSOUS=0
  55. NBREF=0
  56. SEGINI IPT1
  57. IRIGEL(1,1)=IPT1
  58. IRIGEL(4,1)=xMATRI
  59. LVAL=10+ ( IDIM-2)* 11
  60. IRIGEL(3,1)=DESCR
  61. LISINC(1)=MOTU(1)
  62. NOELEP(1)=1
  63. NOELED(1)=1
  64. LISDUA(1)=MOTF(1)
  65. LISINC(2)=MOTU(2)
  66. NOELEP(2)=1
  67. NOELED(2)=1
  68. LISDUA(2)=MOTF(2)
  69. IA=2
  70. IF( IDIM.EQ.3) THEN
  71. IA=3
  72. LISINC(3)=MOTU(3)
  73. LISDUA(3)=MOTF(3)
  74. NOELEP(3)=1
  75. NOELED(3)=1
  76. ENDIF
  77. LISINC(IA+1)=MOTU(1)
  78. NOELEP(IA+1)=2
  79. NOELED(IA+1)=2
  80. LISDUA(IA+1)=MOTF(1)
  81. LISINC(IA+2)=MOTU(2)
  82. NOELEP(IA+2)=2
  83. NOELED(IA+2)=2
  84. LISDUA(IA+2)=MOTF(2)
  85. IF( IDIM.EQ.3) THEN
  86. LISINC(6)=MOTU(3)
  87. LISDUA(6)=MOTF(3)
  88. NOELEP(6)=2
  89. NOELED(6)=2
  90. ENDIF
  91. SEGDES DESCR
  92. IPT1.ITYPEL=2
  93. SEGINI ITRA
  94. segact mcoord*mod
  95. C
  96. C *** BOUCLE 1 SUR LES ELEMENTS ON CREE LE MELEME ET ON FAIT LA
  97. C *** RIGIDITE DU CABLE EN TRACTION COMPRESSION
  98. C *** LES CONDITIONS UNILATERALES SERONT FAITES PLUS TARD
  99.  
  100. DO 1 I=1,NBELEM
  101. IP=NUM(1,I)
  102. IPT1.NUM(1,I)=IP
  103. IPDE=(IP-1)*( IDIM+1)
  104. COR(1)=XCOOR(IPDE+1)
  105. COR(2)=XCOOR(IPDE+2)
  106. COR(3)=0
  107. IF( IDIM.EQ.3)COR(3)=XCOOR(IPDE+3)
  108. NP=(NUM(2,I)-1)*(IDIM+1)
  109. IPT1.NUM(2,I)=XCOOR(/1)/(IDIM+1) +1
  110. XCOOR(**)= XCOOR(NP+1)
  111. XCOOR(**)=XCOOR(NP+2)
  112. IF(IDIM.EQ.3) XCOOR(**)=XCOOR(NP+3)
  113. COR(4)= XCOOR(NP+1)
  114. COR(5)=XCOOR(NP+2)
  115. COR(6)=0
  116. IF(IDIM.EQ.3)COR(6)=XCOOR(NP+3)
  117. XCOOR(**)=XCOOR(NP+1+IDIM)
  118. X21=COR(4)-COR(1)
  119. Y21=COR(5)-COR(2)
  120. Z21=COR(6)-COR(3)
  121. XL=SQRT(X21*X21+Y21*Y21+Z21*Z21)
  122. C(1)=X21/XL
  123. C(2)=Y21/XL
  124. C(3)=Z21/XL
  125. R=FE/(EPS*XL)
  126. DO 2 K=1,idim
  127. K1=K+idim
  128. DO 2 J=1,idim
  129. J1=J+idim
  130. XK(K,J)=C(K)*R*C(J)
  131. XK(K1,J1)=XK(K,J)
  132. XK(K ,J1)=-XK(K,J)
  133. XK(K1,J )=-XK(K,J)
  134. 2 CONTINUE
  135. KJ=1
  136. * SEGINI XMATRI
  137. * DO 3 K=1,2*IDIM
  138. * KJ=KJ+K-1
  139. * K1=K
  140. * IF(IDIM.EQ.2.AND.K.GT.IDIM) K1=K1+1
  141. * DO 3 J=1,K
  142. * IK=J-1
  143. * J1=J
  144. * IF(IDIM.EQ.2.AND.J.GT.IDIM) J1=J1+1
  145. * RE(KJ+IK)=XK(K1,J1)
  146. * 3 CONTINUE
  147. DO 3 K=1,IDIM*2
  148. DO 3 J=1,IDIM*2
  149. RE(J,K,i)=XK(J,K)
  150. 3 CONTINUE
  151. * SEGDES XMATRI
  152. * IMATTT(I)=XMATRI
  153. 1 CONTINUE
  154. SEGDES xMATRI
  155. C
  156. C **** ON REPREND TOUS LES ELEMENTS POUR CREER LES CONDITIONS
  157. C **** UNILATERALES
  158. C
  159. NLIGRP=IDIM*2 + 2
  160. NLIGRD=IDIM*2 + 2
  161. NBNN=4
  162. SEGINI DESCR
  163. LISINC(1)='LX '
  164. LISDUA(1)='FLX'
  165. NOELEP(1)=1
  166. NOELED(1)=1
  167. LISINC(2)='LX '
  168. LISDUA(2)='FLX'
  169. NOELEP(2)=2
  170. NOELED(2)=2
  171. LISINC(3)=MOTU(1)
  172. LISDUA(3)=MOTF(1)
  173. NOELEP(3)=3
  174. NOELED(3)=3
  175. LISINC(4)=MOTU(2)
  176. LISDUA(4)=MOTF(2)
  177. NOELEP(4)=3
  178. NOELED(4)=3
  179. IA=2
  180. IF(IDIM.EQ.3) THEN
  181. LISINC(5)=MOTU(3)
  182. LISDUA(5)=MOTF(3)
  183. NOELEP(5)=3
  184. NOELED(5)=3
  185. IA=3
  186. ENDIF
  187. LISINC(IA+3)=MOTU(1)
  188. LISDUA(IA+3)=MOTF(1)
  189. NOELEP(IA+3)=4
  190. NOELED(IA+3)=4
  191. LISINC(IA+4)=MOTU(2)
  192. LISDUA(IA+4)=MOTF(2)
  193. NOELEP(IA+4)=4
  194. NOELED(IA+4)=4
  195. IF(IDIM.EQ.3) THEN
  196. LISINC(8)=MOTU(3)
  197. LISDUA(8)=MOTF(3)
  198. NOELEP(8)=4
  199. NOELED(8)=4
  200. ENDIF
  201. SEGDES DESCR
  202. IRIGEL(3,2)=DESCR
  203. IRIGEL(3,3)=DESCR
  204. if(idim.eq.3)IRIGEL(3,4)=DESCR
  205. SEGINI xMATRI
  206. IRIGEL(4,2)=xMATRI
  207. SEGINI IPT2
  208. IPT2.ITYPEL=22
  209. IRIGEL(1,2)=IPT2
  210. IRIGEL(5,2)=NIFOUR
  211. IRIGEL(5,3)=NIFOUR
  212. if (idim.eq.3)IRIGEL(5,4)=NIFOUR
  213. IRIGEL(6,2)=1
  214. IRIGEL(6,3)=0
  215. if( idim.eq.3) IRIGEL(6,4)=0
  216. * LVAL=(NLIGRE*NLIGRE+NLIGRE)/2
  217. C
  218. C **** BOUCLE SUR LES ELEMENTS ON CREES IPT2 ET LES RIGIDITES
  219. C
  220. DO 500 JOP=1,idim
  221. IF(JOP.GE.2) THEN
  222. SEGDES xMATRI,IPT2
  223. SEGINI xMATRI,IPT2
  224. IPT2.ITYPEL=22
  225. IRIGEL(1,JOP+1)=IPT2
  226. IRIGEL(4,JOP+1)=xMATRI
  227. ENDIF
  228. DO 50 I=1,NBELEM
  229. I1=NUM(2,I)
  230. I2=IPT1.NUM(2,I)
  231. IL1=XCOOR(/1)/(IDIM+1)+1
  232. IL2=IL1+1
  233. IN1=(I1-1)*(IDIM+1)
  234. IN2=(I2-1)*(IDIM+1)
  235. XCOOR(**)=XCOOR(IN1+1)
  236. XCOOR(**)=XCOOR(IN1+2)
  237. IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN1+3)
  238. XCOOR(**)=XCOOR(IN1+IDIM+1)
  239. XCOOR(**)=XCOOR(IN2+1)
  240. XCOOR(**)=XCOOR(IN2+2)
  241. IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN2+3)
  242. XCOOR(**)=XCOOR(IN1+IDIM+1)
  243. IPT2.NUM(1,I)=IL1
  244. IPT2.NUM(2,I)=IL2
  245. IPT2.NUM(3,I)=I1
  246. IPT2.NUM(4,I)=I2
  247. * SEGINI XMATRI
  248. RE(1,1,i)=-1.D0
  249. RE(2,1,i)=1.D0
  250. RE(1,2,i)=1.D0
  251. RE(2,2,i)=-1.D0
  252. IP1=NUM(1,I)
  253. INP1=(IP1-1)*(IDIM+1)
  254. C(1)=XCOOR(IN1+1)-XCOOR(INP1+1)
  255. C(2)=XCOOR(IN1+2)-XCOOR(INP1+2)
  256. C(3)=0.D0
  257. IF(IDIM.EQ.3) C(3)=XCOOR(IN1+3)-XCOOR(INP1+3)
  258. XL= SQRT( C(1)*C(1)+C(2)*C(2)+C(3)*C(3))
  259. C(1)=C(1)/XL
  260. C(2)=C(2)/XL
  261. C(3)=C(3)/XL
  262. IF(JOP.EQ.2) THEN
  263. D(1)=-C(2)
  264. D(2)=C(1)
  265. D(3)=0.D0
  266. XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  267. IF(XL.LT.1.D-3) THEN
  268. D(1)=-C(3)
  269. D(2)=0D0
  270. D(3)=C(1)
  271. XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  272. ENDIF
  273. C(1)=D(1)/XL
  274. C(2)=D(2)/XL
  275. C(3)=D(3)/XL
  276. ENDIF
  277. IF(JOP.EQ.3) THEN
  278. D(1)=-C(2)
  279. D(2)=C(1)
  280. D(3)=0.
  281. XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  282. IF(XL.LT.1.D-3) THEN
  283. D(1)=-C(3)
  284. D(2)=0.
  285. D(3)=C(1)
  286. XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  287. ENDIF
  288. D(1)=D(1)/XL
  289. D(2)=D(2)/XL
  290. D(3)=D(3)/XL
  291. E(1)=C(2)*D(3)-C(3)*D(2)
  292. E(2)=C(3)*D(1)-C(1)*D(3)
  293. E(3)=C(1)*D(2)-C(2)*D(1)
  294. C(1)=E(1)
  295. C(2)=E(2)
  296. C(3)=E(3)
  297. ENDIF
  298. RE(3,1,i)=C(1)
  299. RE(3,2,i)=C(1)
  300. RE(1,3,i)=C(1)
  301. RE(2,3,i)=C(1)
  302. RE(4,1,i)=C(2)
  303. RE(4,2,i)=C(2)
  304. RE(1,4,i)=C(2)
  305. RE(2,4,i)=C(2)
  306. IA=4
  307. * IB=15
  308. IF(IDIM.EQ.3) THEN
  309. RE(5,1,i)=C(3)
  310. RE(5,2,i)=C(3)
  311. RE(1,5,i)=C(3)
  312. RE(2,5,i)=C(3)
  313. IA=5
  314. * IB=21
  315. ENDIF
  316. RE(IA+1,1,i)=-C(1)
  317. RE(IA+1,2,i)=-C(1)
  318. RE(1,IA+1,i)=-C(1)
  319. RE(2,IA+1,i)=-C(1)
  320. RE(IA+2,1,i)=-C(2)
  321. RE(IA+2,2,i)=-C(2)
  322. RE(1,IA+2,i)=-C(2)
  323. RE(2,IA+2,i)=-C(2)
  324. IF(IDIM.EQ.3) THEN
  325. RE(IA+3,1,i)=-C(3)
  326. RE(IA+3,2,i)=-C(3)
  327. RE(1,IA+3,i)=-C(3)
  328. RE(2,IA+3,i)=-C(3)
  329. ENDIF
  330. * SEGDES XMATRI
  331. * IMATTT(I)=XMATRI
  332. 50 CONTINUE
  333. 500 CONTINUE
  334. SEGDES MELEME,IPT1,IPT2,xMATRI
  335. SEGDES MRIGID
  336. SEGSUP ITRA
  337. CALL ECROBJ('RIGIDITE',MRIGID)
  338. RETURN
  339. END
  340.  
  341.  
  342.  

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