Télécharger jaucau.eso

Retour à la liste

Numérotation des lignes :

  1. C JAUCAU SOURCE FANDEUR 14/03/26 21:15:09 8008
  2.  
  3. SUBROUTINE JAUCAU (NBNN,tab1,Ncoele,NBPTEL,SHPTOT,XE1,XE2,
  4. & SHPWRK,tab,KCAS,mwrk5,LADIM,mele,iipdpg)
  5.  
  6. implicit real*8(a-h,o-z)
  7. implicit integer (i-n)
  8.  
  9. -INC CCOPTIO
  10.  
  11. SEGMENT MWRK5
  12. REAL*8 BGR(NGRA,LRE),BB(2,NGRA),gradi(ngra),R(ngra),u(ngra)
  13. REAL*8 TENS(9),tentra(9),xddls2(lre)
  14. ENDSEGMENT
  15. dimension xe1(3,*),xe2(3,*)
  16. dimension shpwrk(6,*),shptot(6,NBNN,*)
  17. dimension tab(nbptel,*),tab1(nbptel,*)
  18. C
  19. xxzero=0.d0
  20. if (kcas.eq.2) then
  21. xxr=2.0d0
  22. uxr=0.5d0
  23. else
  24. xxr=1.d0
  25. uxr=1.D0
  26. endif
  27. C
  28. C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS
  29. C
  30. DO 50 IB=1,NCOELE
  31. DO 50 IA=1,NBPTEL
  32. TAB(IA,IB)=0.D0
  33. 50 CONTINUE
  34. DO i = 1, 9
  35. TENS(i) = xxZero
  36. ENDDO
  37.  
  38. ngra=gradi(/1)
  39. lre=xddls2(/1)
  40. NHRM=NIFOUR
  41.  
  42. C Calcul de l'increment de deplacement
  43. ia=0
  44. do iou=1,NBNN
  45. do iyu=1, idim
  46. ia=ia+1
  47. xddls2(ia)= XE2(iyu,iou) - xe1(iyu,iou)
  48. enddo
  49. enddo
  50. C - MODES DE CALCUL EN DEFORMATIONS "PLANES" GENERALISEES
  51. IF (IDIM.EQ.3) THEN
  52. C RIEN FAIRE !
  53. C CAS 2D :
  54. ELSE IF (IDIM.EQ.2) THEN
  55. CC CAS 2D PLAN DEFO GENE
  56. C Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(3,1) (cf. PIOCAP)
  57. IF (IFOUR.EQ.-3) THEN
  58. IA = IA + 1
  59. xddls2(ia)= XE2(3,1)
  60. ENDIF
  61. C CAS 1D :
  62. ELSE IF (IDIM.EQ.1) THEN
  63. CCC CAS 1D PLAN
  64. IF (IFOUR.GE.3 .AND. IFOUR.LE.11) THEN
  65. C Rq : "Deplacement" UY du PTGENE est stocke dans XE2(2,1) (cf. PIOCAP)
  66. IF (IFOUR.EQ.7 .OR. IFOUR.EQ.8 .OR. IFOUR.EQ.11) THEN
  67. IA = IA + 1
  68. xddls2(ia)= XE2(2,1)
  69. ENDIF
  70. C Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(3,1) (cf. PIOCAP)
  71. c* IF (IFOUR.EQ.9 .OR. IFOUR.EQ.10 .OR. IFOUR.EQ.11) THEN
  72. IF (IFOUR.GE.9) THEN
  73. IA = IA + 1
  74. xddls2(ia)= XE2(3,1)
  75. ENDIF
  76. CCC CAS 1D AXIS
  77. C Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(2,1) (cf. PIOCAP)
  78. ELSE IF (IFOUR.EQ.14) THEN
  79. IA = IA + 1
  80. xddls2(ia)= XE2(2,1)
  81. ENDIF
  82. ENDIF
  83.  
  84. C Boucle sur les points d'intergration de l'element :
  85. do 51 igau=1,nbptel
  86.  
  87. C Calcul du gradient du deplacment
  88. CALL BGRMAS(iGau,mele,nbnn,LRE,IFOUR,NGRA,NHRM,XE1,
  89. & xXZero,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG)
  90. CALL BGRDEP(BGR,NGRA,XDDLs2,LRE,GRADI)
  91.  
  92. C Calcul de F
  93. IF (LADIM.EQ.3) THEN
  94. gradi(1)=gradi(1)+1.D0
  95. gradi(5)=gradi(5)+1.D0
  96. gradi(9)=gradi(9)+1.D0
  97. C* ELSE if (LADIM.EQ.2) then
  98. ELSE
  99. gradi(1)=gradi(1)+1.D0
  100. gradi(4)=gradi(4)+1.D0
  101. ENDIF
  102.  
  103. CALL POLA2(gradi,R,U,LADIM)
  104. * fait le rtens R.A.Rt on utilise u pour mettre Rt
  105. * et on met le tenseur dans le tableau tens
  106. * attention, vu le stockage R est en fait Rt
  107. if (LAdim.eq.2) then
  108. U(1)=r(1)
  109. u(2)=r(3)
  110. U(3)=R(2)
  111. u(4)=R(4)
  112. tens(1)=tab1(igau,1)
  113. tens(2)=tab1(igau,4)*uxr
  114. tens(3)=tens(2)
  115. tens(4)=tab1(igau,2)
  116. c* else if (LAdim.eq.3) then
  117. else
  118. U(1)=r(1)
  119. u(2)=r(4)
  120. U(3)=R(7)
  121. u(4)=R(2)
  122. u(5)=r(5)
  123. u(6)=r(8)
  124. u(7)=r(3)
  125. u(8)=r(6)
  126. u(9)=r(9)
  127. tens(1)=tab1(igau,1)
  128. tens(5)=tab1(igau,2)
  129. tens(9)=tab1(igau,3)
  130. IF (IFOUR.EQ.1.OR.IFOUR.EQ.2) THEN
  131. tens(2)=tab1(igau,4)*uxr
  132. tens(3)=tab1(igau,5)*uxr
  133. tens(4)=tens(2)
  134. tens(6)=tab1(igau,6)*uxr
  135. tens(7)=tens(3)
  136. tens(8)=tens(6)
  137. ELSE IF (IFOUR.LE.0) THEN
  138. c* ELSE IF (IFOUR.EQ.0.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3
  139. c* & IFOUR.EQ.-1) THEN
  140. tens(2)=tab1(igau,4)*uxr
  141. * tens(3)=xxzero
  142. tens(4)=tens(2)
  143. * tens(6)=xxzero
  144. * tens(7)=tens(3)
  145. * tens(8)=tens(6)
  146. * tens(9)=tab1(igau,3)=xxzero pour IFOUR=-1
  147. * Modes de calcul 1D
  148. c ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  149. * tens(2)=xxzero
  150. * tens(3)=xxzero
  151. * tens(4)=tens(2)
  152. * tens(6)=xxzero
  153. * tens(7)=tens(3)
  154. * tens(8)=tens(6)
  155. ELSE
  156. CALL ERREUR(19)
  157. RETURN
  158. ENDIF
  159. endif
  160. CALL MULMAT(tentra,tens,R,LADIM,LADIM,LADIM)
  161. CALL MULMAT(tens,U,Tentra,LADIM,LADIM,LADIM)
  162. if(ladim.eq.2) then
  163. tab(igau,1)=tens(1)
  164. tab(igau,2)=tens(4)
  165. tab(igau,4)=tens(2)*xxr
  166. tab(igau,3)=tab1(igau,3)
  167. else
  168. tab(igau,1)=tens(1)
  169. tab(igau,2)=tens(5)
  170. tab(igau,3)=tens(9)
  171. IF (IFOUR.EQ.1.OR.IFOUR.EQ.2) THEN
  172. tab(igau,4)=tens(2)*xxr
  173. tab(igau,5)=tens(3)*xxr
  174. tab(igau,6)=tens(6)*xxr
  175. ELSE IF (IFOUR.LE.0) THEN
  176. c* ELSE IF (IFOUR.EQ.0.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3
  177. c* & IFOUR.EQ.-1) THEN
  178. tab(igau,4)=tens(2)*xxr
  179. * Modes de calcul 1D
  180. c* ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  181. ENDIF
  182. endif
  183.  
  184. 51 CONTINUE
  185.  
  186. RETURN
  187. END
  188.  
  189.  
  190.  

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