Télécharger piocaf.eso

Retour à la liste

Numérotation des lignes :

  1. C PIOCAF SOURCE PV 16/03/10 21:15:01 8853
  2. SUBROUTINE PIOCAF(NBNN,nbsh,IDIM,TAB1,NCOELE,NBPTEL,SHP,XE1,
  3. 1 XE2,SH1,TAB,IFOU,KCAS,KERRE)
  4. C=======================================================================
  5. C
  6. C TRANSFORME LES CONTRAINTES DE PIOLA KIRCHHOFF EN CONTRAINTES DE
  7. C CAUCHY
  8. C ENTREE
  9. C -------
  10. C NBNN = NOMBRE DE POINTS PAR ELEMENTS
  11. C NBSH = NOMBRE DE fonctions de forme
  12. C IDIM = DIMENSION DE L ESPACE SUPPORT
  13. C
  14. C TAB1(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE PIOLA KIRCHHOFF
  15. C
  16. C NCOELE = NOMBRE DE COMPOSTS TABLEAU DES CONTRAINTES
  17. C
  18. C NBPTEL = NOMBRE DE POINTS DE GAUSS
  19. C SHP(6,NBNN,NBPTEL)= FONCTIONS DE FORME
  20. C
  21. C KCAS = 1 SI CONTRAINTES, 2 SI DEFORMATIONS
  22. C
  23. C TABLEAUX DE TRAVAIL
  24. C--------------------
  25. C XE1(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION DEPART
  26. C
  27. C XE2(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION ACTUEL
  28. C
  29. C SH1(6,NBNN) = FONCTIONS DE FORME EN UN POINT DE GAUSS
  30. C
  31. C SORTIES
  32. C---------
  33. C TAB(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE CAUCHY
  34. C
  35. C
  36. C AOUT 85
  37. C MODIF PEGON FEV 90 CAS BIDIM
  38. C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI 12/4/91
  39. C
  40. C=======================================================================
  41. IMPLICIT INTEGER(I-N)
  42. IMPLICIT REAL*8(A-H,O-Z)
  43. C
  44. DIMENSION TAB1(NBPTEL,*)
  45. DIMENSION TAB(NBPTEL,*)
  46. *as xfem 2010_01_13
  47. DIMENSION SHP(6,NBSH,*)
  48. * DIMENSION SHP(6,NBNN,*)
  49. *fin as xfem 2010_01_13
  50. DIMENSION XE1(3,*),XE2(3,*),SH1(6,*)
  51. C
  52. C TABLEAUX DE TRAVAIL DIMENSIONNES ICI
  53. C
  54. DIMENSION XJAC(3,3),FAC(6)
  55. C
  56. C TABLEAUX INDIQUANT LA CORRESPONDANCE ENTRE INDICES I,J ET NUMERO
  57. C DE LA COMPOSANTE DE CONTRAINTES OU DE DEFORMATIONS
  58. C
  59. DIMENSION IN(6),JN(6),ITAB(3,3)
  60. C
  61. DATA FAC/1.D0,1.D0,1.D0,0.5D0,0.5D0,0.5D0/
  62. DATA IN/1,2,3,1,1,2/
  63. DATA JN/1,2,3,2,3,3/
  64. C
  65. DATA ITAB(1,1),ITAB(1,2),ITAB(1,3)/1,4,5/
  66. DATA ITAB(2,1),ITAB(2,2),ITAB(2,3)/4,2,6/
  67. DATA ITAB(3,1),ITAB(3,2),ITAB(3,3)/5,6,3/
  68. C
  69. KERRE=0
  70. C
  71. C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS
  72. C
  73. DO 50 IA=1,NBPTEL
  74. DO 50 IB=1,NCOELE
  75. TAB(IA,IB)=0.D0
  76. 50 CONTINUE
  77. C
  78. C BOUCLE SUR LES POINTS DE GAUSS
  79. C
  80. DO 130 IC=1,NBPTEL
  81. C
  82. if (nbsh.ne.nbnn) then
  83. CALL HPRIMEX(XE1,NBNN,IDIM,NBSH,SHP,IC,SH1,DJAC)
  84. else
  85. CALL HPRIME(XE1,NBNN,IDIM,SHP,IC,SH1,DJAC)
  86. endif
  87. C
  88. C CALCUL DE LA MATRICE F (=XJAC)
  89. C
  90. CALL ZERO(XJAC,3,3)
  91. DO 140 IF=1,IDIM
  92. JF = IF + 1
  93. DO 140 IE=1,IDIM
  94. r_z = 0.D0
  95. DO 141 ID=1,NBNN
  96. r_z = r_z + SH1(JF,ID)*XE2(IE,ID)
  97. 141 CONTINUE
  98. XJAC(IE,IF) = r_z
  99. 140 CONTINUE
  100. C
  101. CC - MODES DE CALCUL EN DEFORMATIONS "PLANES" GENERALISEES
  102. CC CAS 3D :
  103. IF (IDIM.EQ.3) THEN
  104. C RIEN FAIRE !
  105. CC CAS 2D :
  106. ELSE IF(IDIM.EQ.2) THEN
  107. CCCC CAS 2D AXISYMETRIQUE
  108. IF (IFOU.EQ.0) THEN
  109. R1=0.D0
  110. R2=0.D0
  111. DO 150 ID=1,NBNN
  112. R1=R1+SH1(1,ID)*XE1(1,ID)
  113. R2=R2+SH1(1,ID)*XE2(1,ID)
  114. 150 CONTINUE
  115. XJAC(3,3)=R2/(R1+1.E-20)
  116. ELSE
  117. CCCC CAS 2D PLAN
  118. XJAC(3,3)=1.D0
  119. CCCC CAS 2D PLAN DEFO GENE
  120. * Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(3,1) (cf. PIOCAP)
  121. IF (IFOU.EQ.-3) THEN
  122. XJAC(3,3) = XJAC(3,3) + XE2(3,1)
  123. ENDIF
  124. ENDIF
  125. CC CAS 1D :
  126. ELSE IF (IDIM.EQ.1) THEN
  127. CCCC CAS 1D PLAN
  128. IF (IFOU.GE.3 .AND. IFOU.LE.11) THEN
  129. XJAC(2,2) = 1.D0
  130. XJAC(3,3) = 1.D0
  131. * Rq : "Deplacement" UY du PTGENE est stocke dans XE2(2,1) (cf. PIOCAP)
  132. IF (IFOU.EQ.7 .OR. IFOU.EQ.8 .OR. IFOU.EQ.11) THEN
  133. XJAC(2,2) = XJAC(2,2) + XE2(2,1)
  134. ENDIF
  135. * Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(3,1) (cf. PIOCAP)
  136. c* IF (IFOU.EQ.9 .OR. IFOU.EQ.10 .OR. IFOU.EQ.11) THEN
  137. IF (IFOU.GE.9) THEN
  138. XJAC(3,3) = XJAC(3,3) + XE2(3,1)
  139. ENDIF
  140. CCCC CAS 1D AXIS et SPHE
  141. ELSE
  142. CALL DISTRR(XE1,SH1,NBNN,R1)
  143. CALL DISTRR(XE2,SH1,NBNN,R2)
  144. FR2R1 = R2 / (R1+1.E-20)
  145. XJAC(3,3) = FR2R1
  146. CCCC CAS 1D SPHE
  147. IF (IFOU.EQ.15) THEN
  148. XJAC(2,2) = FR2R1
  149. ELSE
  150. CCCC CAS 1D AXIS
  151. XJAC(2,2) = 1.D0
  152. * Rq : "Deplacement" UZ du PTGENE est stocke dans XE2(2,1) (cf. PIOCAP)
  153. IF (IFOU.EQ.14) THEN
  154. XJAC(2,2) = XJAC(2,2) + XE2(2,1)
  155. ENDIF
  156. ENDIF
  157. ENDIF
  158. ENDIF
  159. C
  160. GO TO (500,600),KCAS
  161. C
  162. C KCAS=1 CAS DES CONTRAINTES
  163. C ----------------------------
  164. C
  165. 500 CONTINUE
  166. C
  167. CCCCCCCCCCCC CALCUL DE L'INVERSE DU DETERMINANT DE F
  168. C
  169. IF (IDIM.EQ.3) THEN
  170. DETF=XJAC(1,1)*(XJAC(2,2)*XJAC(3,3)-XJAC(3,2)*XJAC(2,3))
  171. DETF=DETF-XJAC(2,1)*(XJAC(1,2)*XJAC(3,3)-XJAC(3,2)*XJAC(1,3))
  172. DETF=DETF+XJAC(3,1)*(XJAC(1,2)*XJAC(2,3)-XJAC(1,3)*XJAC(2,2))
  173. ELSE IF (IDIM.EQ.2) THEN
  174. DETF = ( XJAC(1,1)*XJAC(2,2)-XJAC(1,2)*XJAC(2,1) ) * XJAC(3,3)
  175. ELSE IF (IDIM.EQ.1) THEN
  176. DETF = XJAC(1,1) * XJAC(2,2) * XJAC(3,3)
  177. ENDIF
  178. DETF=1./(DETF+1.E-20)
  179. C
  180. C CALCUL DES CONTRAINTES DE CAUCHY
  181. C
  182. DO 160 ID=1,NCOELE
  183. IND=IN(ID)
  184. JND=JN(ID)
  185. DO 170 IE=1,IDIM
  186. DO 170 IF=1,IDIM
  187. ICO=ITAB(IE,IF)
  188. TAB(IC,ID)=TAB1(IC,ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF
  189. 1 +TAB(IC,ID)
  190. 170 CONTINUE
  191. 160 CONTINUE
  192. C
  193. C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE
  194. C
  195. IF (IDIM.EQ.2) THEN
  196. TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3)*DETF
  197. ELSE IF (IDIM.EQ.1) THEN
  198. TAB(IC,2)=TAB1(IC,2)*XJAC(2,2)*XJAC(2,2)*DETF
  199. TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3)*DETF
  200. ENDIF
  201. GO TO 130
  202. C
  203. C KCAS=2 CAS DES DEFORMATIONS
  204. C -----------------------------
  205. C
  206. 600 CONTINUE
  207. C
  208. C
  209. CCCCCCCCCCCC CALCUL DE L'INVERSE DE F
  210. C
  211. CALL INVMA1(XJAC,3,3,KERRE)
  212. IF(KERRE.NE.0) THEN
  213. WRITE(6,77881) ((XJAC(MI,MJ),MJ=1,3),MI=1,3)
  214. 77881 FORMAT(2X,' MATRICE SINGULIERE' /(3(1X,1PE12.5)/))
  215. RETURN
  216. ENDIF
  217. C
  218. C CALCUL DES DEFORMATIONS
  219. C
  220. DO 260 ID=1,NCOELE
  221. IND=IN(ID)
  222. JND=JN(ID)
  223. DO 270 IE=1,IDIM
  224. DO 270 IF=1,IDIM
  225. ICO=ITAB(IE,IF)
  226. TAB(IC,ID)=TAB(IC,ID) +
  227. 1 FAC(ICO)*TAB1(IC,ICO)*XJAC(IE,IND)*XJAC(IF,JND)/FAC(ID)
  228. 270 CONTINUE
  229. 260 CONTINUE
  230. C
  231. C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE
  232. C
  233. IF(IDIM.EQ.2) THEN
  234. TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3)
  235. ELSE IF(IDIM.EQ.1) THEN
  236. TAB(IC,2)=TAB1(IC,2)*XJAC(2,2)*XJAC(2,2)*DETF
  237. TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3)*DETF
  238. ENDIF
  239. C
  240. 130 CONTINUE
  241. C
  242. RETURN
  243. END
  244.  
  245.  
  246.  
  247.  

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