Télécharger ricabl.eso

Retour à la liste

Numérotation des lignes :

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

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