Télécharger jaucau.eso

Retour à la liste

Numérotation des lignes :

  1. C JAUCAU SOURCE AM 18/06/06 21:15:01 9834
  2.  
  3. SUBROUTINE JAUCAU (NBNN,tab1,Ncoele,NBPTEL,SHPTOT,XE1,XE2,
  4. & SHPWRK,tab,MWRK6,LHOOK,
  5. & KCAS,mwrk5,LADIM,mele,iipdpg)
  6.  
  7. implicit real*8(a-h,o-z)
  8. implicit integer (i-n)
  9.  
  10. -INC CCOPTIO
  11.  
  12. SEGMENT MWRK5
  13. REAL*8 BGR(NGRA,LRE),BB(2,NGRA),gradi(ngra),R(ngra),u(ngra)
  14. REAL*8 TENS(9),tentra(9),xddls2(lre)
  15. ENDSEGMENT
  16. *
  17. SEGMENT MWRK6
  18. INTEGER ITRES1(NBPTEL)
  19. REAL*8 PRODDI(NBPTEL,LHOO2),PRODDO(NBPTEL,LHOO2)
  20. REAL*8 DDHOOK(LHOOK,LHOOK),DDHOMU(LHOOK,LHOOK)
  21. REAL*8 VEC(LHOOK),VEC2(LHOOK)
  22. ENDSEGMENT
  23. *
  24. dimension xe1(3,*),xe2(3,*)
  25. dimension shpwrk(6,*),shptot(6,NBNN,*)
  26. dimension tab(nbptel,*),tab1(nbptel,*)
  27. DIMENSION IDD(3),RM(6,6),SM(6,6)
  28.  
  29. C
  30. PARAMETER (RAC2 = 1.414213562373090 D0)
  31. C
  32. DATA IDD/2,3,1/
  33. C
  34. xxzero=0.d0
  35. if (kcas.eq.2) then
  36. xxr=2.0d0
  37. uxr=0.5d0
  38. else
  39. xxr=1.d0
  40. uxr=1.D0
  41. endif
  42.  
  43. C
  44. C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS
  45. C
  46. DO 50 IB=1,NCOELE
  47. DO 50 IA=1,NBPTEL
  48. TAB(IA,IB)=0.D0
  49. 50 CONTINUE
  50. DO i = 1, 9
  51. TENS(i) = xxZero
  52. ENDDO
  53.  
  54. ngra=gradi(/1)
  55. lre=xddls2(/1)
  56. NHRM=NIFOUR
  57.  
  58. C Calcul de l'increment de deplacement
  59. ia=0
  60. do iou=1,NBNN
  61. do iyu=1, idim
  62. ia=ia+1
  63. xddls2(ia)= XE2(iyu,iou) - xe1(iyu,iou)
  64. enddo
  65. enddo
  66. C - MODES DE CALCUL EN DEFORMATIONS "PLANES" GENERALISEES
  67. IF (IDIM.EQ.3) THEN
  68. C RIEN FAIRE !
  69. C CAS 2D :
  70. ELSE IF (IDIM.EQ.2) THEN
  71. CC CAS 2D PLAN DEFO GENE
  72. C Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(3,1) (cf. PIOCAP)
  73. IF (IFOUR.EQ.-3) THEN
  74. IA = IA + 1
  75. xddls2(ia)= XE2(3,1)
  76. ENDIF
  77. C CAS 1D :
  78. ELSE IF (IDIM.EQ.1) THEN
  79. CCC CAS 1D PLAN
  80. IF (IFOUR.GE.3 .AND. IFOUR.LE.11) THEN
  81. C Rq : "Deplacement" UY du PTGENE est stocke dans XE2(2,1) (cf. PIOCAP)
  82. IF (IFOUR.EQ.7 .OR. IFOUR.EQ.8 .OR. IFOUR.EQ.11) THEN
  83. IA = IA + 1
  84. xddls2(ia)= XE2(2,1)
  85. ENDIF
  86. C Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(3,1) (cf. PIOCAP)
  87. c* IF (IFOUR.EQ.9 .OR. IFOUR.EQ.10 .OR. IFOUR.EQ.11) THEN
  88. IF (IFOUR.GE.9) THEN
  89. IA = IA + 1
  90. xddls2(ia)= XE2(3,1)
  91. ENDIF
  92. CCC CAS 1D AXIS
  93. C Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(2,1) (cf. PIOCAP)
  94. ELSE IF (IFOUR.EQ.14) THEN
  95. IA = IA + 1
  96. xddls2(ia)= XE2(2,1)
  97. ENDIF
  98. ENDIF
  99.  
  100. C Boucle sur les points d'intergration de l'element :
  101. do 51 igau=1,nbptel
  102.  
  103. C Calcul du gradient du deplacment
  104. CALL BGRMAS(iGau,mele,nbnn,LRE,IFOUR,NGRA,NHRM,XE1,
  105. & xXZero,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG)
  106. CALL BGRDEP(BGR,NGRA,XDDLs2,LRE,GRADI)
  107.  
  108. C Calcul de F
  109. IF (LADIM.EQ.3) THEN
  110. gradi(1)=gradi(1)+1.D0
  111. gradi(5)=gradi(5)+1.D0
  112. gradi(9)=gradi(9)+1.D0
  113. C* ELSE if (LADIM.EQ.2) then
  114. ELSE
  115. gradi(1)=gradi(1)+1.D0
  116. gradi(4)=gradi(4)+1.D0
  117. ENDIF
  118.  
  119. CALL POLA2(gradi,R,U,LADIM)
  120.  
  121. *
  122. GO TO (500,500,700),KCAS
  123. *
  124. *
  125. * KCAS=1 OU 2 CAS DES CONTRAINTES OU DES DEFORMATIONS
  126. * ----------------------------------------------------
  127. *
  128. 500 CONTINUE
  129.  
  130. * fait le rtens R.A.Rt on utilise u pour mettre Rt
  131. * et on met le tenseur dans le tableau tens
  132. * attention, vu le stockage R est en fait Rt
  133. if (LAdim.eq.2) then
  134. U(1)=r(1)
  135. u(2)=r(3)
  136. U(3)=R(2)
  137. u(4)=R(4)
  138. tens(1)=tab1(igau,1)
  139. tens(2)=tab1(igau,4)*uxr
  140. tens(3)=tens(2)
  141. tens(4)=tab1(igau,2)
  142. c* else if (LAdim.eq.3) then
  143. else
  144. U(1)=r(1)
  145. u(2)=r(4)
  146. U(3)=R(7)
  147. u(4)=R(2)
  148. u(5)=r(5)
  149. u(6)=r(8)
  150. u(7)=r(3)
  151. u(8)=r(6)
  152. u(9)=r(9)
  153. tens(1)=tab1(igau,1)
  154. tens(5)=tab1(igau,2)
  155. tens(9)=tab1(igau,3)
  156. IF (IFOUR.EQ.1.OR.IFOUR.EQ.2) THEN
  157. tens(2)=tab1(igau,4)*uxr
  158. tens(3)=tab1(igau,5)*uxr
  159. tens(4)=tens(2)
  160. tens(6)=tab1(igau,6)*uxr
  161. tens(7)=tens(3)
  162. tens(8)=tens(6)
  163. ELSE IF (IFOUR.LE.0) THEN
  164. c* ELSE IF (IFOUR.EQ.0.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3
  165. c* & IFOUR.EQ.-1) THEN
  166. tens(2)=tab1(igau,4)*uxr
  167. * tens(3)=xxzero
  168. tens(4)=tens(2)
  169. * tens(6)=xxzero
  170. * tens(7)=tens(3)
  171. * tens(8)=tens(6)
  172. * tens(9)=tab1(igau,3)=xxzero pour IFOUR=-1
  173. * Modes de calcul 1D
  174. c ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  175. * tens(2)=xxzero
  176. * tens(3)=xxzero
  177. * tens(4)=tens(2)
  178. * tens(6)=xxzero
  179. * tens(7)=tens(3)
  180. * tens(8)=tens(6)
  181. ELSE
  182. CALL ERREUR(19)
  183. RETURN
  184. ENDIF
  185. endif
  186. CALL MULMAT(tentra,tens,R,LADIM,LADIM,LADIM)
  187. CALL MULMAT(tens,U,Tentra,LADIM,LADIM,LADIM)
  188. if(ladim.eq.2) then
  189. tab(igau,1)=tens(1)
  190. tab(igau,2)=tens(4)
  191. tab(igau,4)=tens(2)*xxr
  192. tab(igau,3)=tab1(igau,3)
  193. else
  194. tab(igau,1)=tens(1)
  195. tab(igau,2)=tens(5)
  196. tab(igau,3)=tens(9)
  197. IF (IFOUR.EQ.1.OR.IFOUR.EQ.2) THEN
  198. tab(igau,4)=tens(2)*xxr
  199. tab(igau,5)=tens(3)*xxr
  200. tab(igau,6)=tens(6)*xxr
  201. ELSE IF (IFOUR.LE.0) THEN
  202. c* ELSE IF (IFOUR.EQ.0.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3
  203. c* & IFOUR.EQ.-1) THEN
  204. tab(igau,4)=tens(2)*xxr
  205. * Modes de calcul 1D
  206. c* ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  207. ENDIF
  208. endif
  209. *
  210. GO TO 130
  211.  
  212. C
  213. C KCAS=3 CAS DE LA MATRICE DE HOOKE
  214. C ----------------------------------
  215. C
  216. 700 CONTINUE
  217. C
  218. IJ=1
  219. FACJ=1.
  220. DO 710 JJ=1,LHOOK
  221. IF(JJ.GT.3) FACJ=RAC2
  222. DO 710 II=1,LHOOK
  223. IF(II.GT.3) THEN
  224. FACI=RAC2
  225. ELSE
  226. FACI=1.
  227. ENDIF
  228. DDHOOK(II,JJ)=PRODDI(IGAU,IJ)*FACJ*FACI
  229. IJ=IJ+1
  230. 710 CONTINUE
  231. *
  232. IF(LADIM.EQ.2) THEN
  233.  
  234. CALL ZERO(RM,6,6)
  235. DO I=1,LADIM
  236. IN=(I-1)*LADIM
  237. DO J=1,LADIM
  238. JJ =IN + J
  239. RM(I,J)=R(JJ)*R(JJ)
  240. ENDDO
  241. RM(I,4)=RAC2*R(2*I-1)*R(2*I)
  242. RM(4,I)=RAC2*R(I)*R(I+LADIM)
  243. ENDDO
  244. RM(3,3)=1.
  245. RM(4,4)=R(1)*R(4)+R(2)*R(3)
  246.  
  247. ELSE IF (LADIM.EQ.3) THEN
  248.  
  249. DO I=1,LADIM
  250. IN=(I-1)*LADIM
  251. IP=(IDD(I)-1)*LADIM
  252. DO J=1,LADIM
  253. JJ =IN + J
  254. J2 =IN + IDD(J)
  255. J3 =IP + J
  256. RM(I,J)=R(JJ)*R(JJ)
  257. RM(I,J+LADIM)=RAC2*R(JJ)*R(J2)
  258. RM(I+LADIM,J)=RAC2*R(JJ)*R(J3)
  259. RM(I+LADIM,J+LADIM)=R(JJ)*R(IDD(J)+IP)+R(IDD(J)+IN)*R(J3)
  260. ENDDO
  261. ENDDO
  262.  
  263. ENDIF
  264.  
  265. *
  266. DO I=1,LHOOK
  267. DO J=1,LHOOK
  268. SM(I,J)=0.
  269. DO K=1,LHOOK
  270. SM(I,J)=SM(I,J)+DDHOOK(I,K)*RM(K,J)
  271. ENDDO
  272. ENDDO
  273. ENDDO
  274. *
  275. DO I=1,LHOOK
  276. DO J=1,LHOOK
  277. DDHOMU(I,J)=0.
  278. DO K=1,LHOOK
  279. DDHOMU(I,J)=DDHOMU(I,J)+RM(K,I)*SM(K,J)
  280. ENDDO
  281. ENDDO
  282. ENDDO
  283. *
  284. IJ=1
  285. FACJ=1.
  286. DO 780 JJ=1,LHOOK
  287. IF(JJ.GT.3) FACJ=RAC2
  288. DO 780 II=1,LHOOK
  289. IF(II.GT.3) THEN
  290. FACI=RAC2
  291. ELSE
  292. FACI=1.
  293. ENDIF
  294. PRODDO(IGAU,IJ)=DDHOMU(II,JJ)/FACJ/FACI
  295. IJ=IJ+1
  296. 780 CONTINUE
  297. *
  298. *
  299. 130 CONTINUE
  300.  
  301. 51 CONTINUE
  302.  
  303. RETURN
  304. END
  305.  
  306.  
  307.  
  308.  

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