Télécharger bbcal3.eso

Retour à la liste

Numérotation des lignes :

bbcal3
  1. C BBCAL3 SOURCE OF166741 23/04/25 21:15:05 11608
  2.  
  3. SUBROUTINE BBCAL3(MELE,NBNN,MFR,IDIM,XE,
  4. 1 NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  5. 2 NGRA,LRE,IFOUR,NHRM,A,BB,
  6. 3 SHPTOT,SHP,BGR,BU,P)
  7.  
  8. *******************************************************************
  9. * projection de dN/dx dans l espace de dimension inferieure
  10. c=======================================================================
  11. c calcul des composantes de la matrice b-barre-dlatation
  12. c - en 2d: elements ict3,icq4,ict6
  13. c - en 3d: elements ....
  14. c calcul des coefficients de modification de la matrice b-barre-dilatation
  15. c - en 2d: elements icq8
  16. c - en 3d: elements ....
  17. c coefficients {a}={a1,a2,a3}
  18. c=======================================================================
  19. c input
  20. c mele = numero de l'element dans nomtp
  21. c nbnn = nombre de noeuds
  22. c mfr = formulation de l'element
  23. c idim = dimension espace
  24. c xe = coordonnees de l'element
  25. c nbpgau = nombre de points de gauss pour la rigidite
  26. c poigau = poids des points de gauss
  27. c qsigau,etagau,dzegau = coordonnees des points de gauss
  28. c ngra = nombre de composantes du gradient
  29. c lre = nombre de colonnes de la matrice b
  30. c ifour = ifour dans ccoptio
  31. c nhrm = numero du mode de fourier
  32. c bu : tableau utile BGRMAS
  33. c
  34. c output
  35. c tableau des coefficients de modification: a(4,*)
  36. c tableau des composantes bbarre-dilatation: bb(3,*)
  37. c=======================================================================
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8 (A-H,O-Z)
  40.  
  41. -INC CCREEL
  42. PARAMETER (XZer=0.D0, XUn=1.D0, X1s2=0.5D0, X1s4 = 0.25D0,
  43. & X2s3 = 0.666666666666666666666666666666666666666667D0,
  44. & X1s3 = 0.333333333333333333333333333333333333333333D0,
  45. & X1s6 = 0.166666666666666666666666666666666666666667D0)
  46.  
  47. DIMENSION XE(3,*), POIGAU(*),QSIGAU(*),ETAGAU(*),DZEGAU(*),
  48. & SHP(6,*),SHPTOT(6,NBNN,*),
  49. & A(4,*),BB(3,*),BGR(ngra,*),BU(2,*),P(4,*)
  50.  
  51. DIMENSION XNUM1(8),XNUM2(8),XNUM3(8)
  52.  
  53. * write(6,*) 'Entree dans le sousprogramme BBCAL3'
  54.  
  55. IF (MFR.NE.31) GOTO 666
  56. C=======================================================================
  57. C= Elements incompressibles implementes :
  58. C=======================================================================
  59. C= NOM : ICT3, ICQ4, ICT6, ICQ8, ICC8, ICT4, ICP6, IC20, IC10, IC15,
  60. C= MELE : 69 , 70 , 71 , 72 , 73 , 74 , 75 , 76 , 77 , 78 ,
  61. C= NOM : ICY5, IC13
  62. C= MELE : 273, 274
  63. C=======================================================================
  64.  
  65. C= 0 = Quelques initialisations ========================================
  66. IFR = IFOUR+4
  67. IF (IFR.LE.4 .OR. IFR.GE.7) THEN
  68. KINC = 2
  69. ELSE
  70. KINC = 3
  71. ENDIF
  72.  
  73. CALL ZERO(BB,3,60)
  74. IF (MELE.EQ.72 .OR. MELE.GE.76) THEN
  75. CALL ZERO(A,4,60)
  76. CALL ZERO(P,4,4)
  77. ENDIF
  78.  
  79. C= 1 = Branchement selon l'Element Fini BBAR ============================
  80. * write(6,*) 'Element :',MELE
  81. * write(6,*) 'Nombre de points Gauss : ', nbpgau
  82. IF (MELE.EQ.273 .OR. MELE.EQ.274) GOTO 100
  83. GOTO ( 10, 20, 30, 40,100,100,100,100,100,100), (MELE-68)
  84. GOTO 666
  85.  
  86. 3 FORMAT (4(A,I1,A,I1,A,F10.4,2X))
  87. 4 FORMAT (3(A,I1,A,I1,A,F10.4,2X))
  88.  
  89. C=======================================================================
  90. C========== Elements MASSIFS INCOMPRESSIBLES BIDIMENSIONNELS ===========
  91. C=======================================================================
  92.  
  93. *-----------------------------------------------------------------------
  94. *----------------------------- Element ICT3 ----------------------------
  95. *-----------------------------------------------------------------------
  96. 10 CONTINUE
  97. * write(6,*) 'Element ICT3',ifour
  98. * write(6,*) 'Ecriture de la matrice xe[ ]'
  99. * write(6,3) (('xe(',i,',',j,')=',xe(i,j),i=1,2),j=1,3)
  100. GOTO (666,101,101,103),IFR
  101. GOTO 666
  102.  
  103. *--------contraintes planes ou deformations planes (ifour=-2,-1)
  104. 101 CONTINUE
  105. *--------donnee des composantes de bb-dil
  106. r_z = - XE(1,1)*XE(2,3) - XE(1,2)*XE(2,1) + XE(1,2)*XE(2,3)
  107. & + XE(1,1)*XE(2,2) + XE(1,3)*XE(2,1) - XE(1,3)*XE(2,2)
  108. * AIRE = X1s2 * r_z
  109. r_z = XUn / r_z
  110. BB(1,1) = (XE(2,2)-XE(2,3)) * r_z
  111. BB(2,2) = (XE(1,3)-XE(1,2)) * r_z
  112. BB(1,3) = (XE(2,3)-XE(2,1)) * r_z
  113. BB(2,4) = (XE(1,1)-XE(1,3)) * r_z
  114. BB(1,5) = (XE(2,1)-XE(2,2)) * r_z
  115. BB(2,6) = (XE(1,2)-XE(1,1)) * r_z
  116. * write(6,*) 'calcul de aire pour bbdil'
  117. * write(6,*) 'aire = ',AIRE
  118. * write(6,*) 'ecriture de la matrice bb'
  119. * write(6,3) (('bb(',i,',',j,')=',bb(i,j),i=1,3),j=1,2*nbnn)
  120. GOTO 999
  121. *--------axisymetrique (ifour=0)
  122. 103 CONTINUE
  123. *--------donnee des composantes de bb-dil
  124. r_z = - XE(1,1)*XE(2,3) - XE(1,2)*XE(2,1) + XE(1,2)*XE(2,3)
  125. & + XE(1,1)*XE(2,2) + XE(1,3)*XE(2,1) - XE(1,3)*XE(2,2)
  126. * AIRE = X1s6 * r_z * (XE(1,1)+XE(1,2)+XE(1,3))
  127. r_z = XUn / r_z
  128. BB(1,1) = r_z * (XE(2,2)-XE(2,3))
  129. BB(2,2) = r_z * (XE(1,3)-XE(1,2))
  130. BB(1,3) = r_z * (XE(2,3)-XE(2,1))
  131. BB(2,4) = r_z * (XE(1,1)-XE(1,3))
  132. BB(1,5) = r_z * (XE(2,1)-XE(2,2))
  133. BB(2,6) = r_z * (XE(1,2)-XE(1,1))
  134. *-- Integration analytique des termes BB(3,1),BB(3,3),BB(3,5)
  135. BB(3,1) = XUn / (XE(1,1)+XE(1,2)+XE(1,3))
  136. BB(3,3) = BB(3,1)
  137. BB(3,5) = BB(3,1)
  138. * write(6,*) 'calcul de aire pour bbdil'
  139. * write(6,*) 'aire = ',AIRE
  140. * write(6,*) 'ecriture de la matrice bb'
  141. * write(6,4) (('bb(',i,',',j,')=',bb(i,j),i=1,3),j=1,2*nbnn)
  142. GOTO 999
  143.  
  144. *-----------------------------------------------------------------------
  145. *----------------------------- Element ICQ4 ----------------------------
  146. *-----------------------------------------------------------------------
  147. 20 CONTINUE
  148. * write(6,*) 'Element ICQ4',ifour
  149. * write(6,*) 'Ecriture de la matrice xe[ ]'
  150. * write(6,3) (('xe(',i,',',j,')=',xe(i,j),i=1,2),j=1,4)
  151. GOTO (666,201,201,203),IFR
  152. GOTO 666
  153. *--------contraintes planes ou deformations planes (ifour=-2,-1)
  154. 201 CONTINUE
  155. *--------donnee des composantes de bb-dil
  156. r_z = - XE(1,4)*XE(2,3) - XE(1,2)*XE(2,1) + XE(1,1)*XE(2,2)
  157. & - XE(1,1)*XE(2,4) - XE(1,3)*XE(2,2) + XE(1,2)*XE(2,3)
  158. & + XE(1,3)*XE(2,4) + XE(1,4)*XE(2,1)
  159. * AIRE = X1s2 * r_z
  160. r_z = XUn / r_z
  161. BB(1,1) = r_z * (XE(2,2)-XE(2,4))
  162. BB(2,2) = r_z * (XE(1,4)-XE(1,2))
  163. BB(1,3) = r_z * (XE(2,3)-XE(2,1))
  164. BB(2,4) = r_z * (XE(1,1)-XE(1,3))
  165. BB(1,5) = r_z * (XE(2,4)-XE(2,2))
  166. BB(2,6) = r_z * (XE(1,2)-XE(1,4))
  167. BB(1,7) = r_z * (XE(2,1)-XE(2,3))
  168. BB(2,8) = r_z * (XE(1,3)-XE(1,1))
  169. * write (*,*) 'calcul de aire pour bbdil'
  170. * write (*,*) 'aire = ',aire
  171. * write (*,*) 'ecriture de la matrice bb'
  172. * write (*,4) (('bb(',i,',',j,')=',bb(i,j),i=1,3),j=1,2*nbnn)
  173. GOTO 999
  174. *
  175. *--------axisymetriques(ifour=0)
  176. 203 CONTINUE
  177. r_z = XE(1,1)*( XE(1,1)*XE(2,2)-XE(1,1)*XE(2,4)-XE(1,4)*XE(2,4)
  178. & +XE(1,4)*XE(2,1)-XE(1,2)*XE(2,1)+XE(1,2)*XE(2,2))
  179. & + XE(1,2)*(-XE(1,2)*XE(2,1)+XE(1,2)*XE(2,3)+XE(1,3)*XE(2,3)
  180. & -XE(1,3)*XE(2,2))
  181. & + XE(1,3)*( XE(1,3)*XE(2,4)+XE(1,4)*XE(2,4)-XE(1,4)*XE(2,3)
  182. & -XE(1,3)*XE(2,2))
  183. & + XE(1,4)*XE(1,4)*(XE(2,1)-XE(2,3))
  184. * AIRE = x1s6 * r_z
  185. r_z = xUn / r_z
  186. BB(1,1) = ( XE(2,2)*(XE(1,2)+XE(1,1))-XE(2,4)*(XE(1,1)+XE(1,4))
  187. & +X1s2*( XE(1,3)*(XE(2,2)-XE(2,4))
  188. & +XE(1,4)*(XE(2,2)+XE(2,3))
  189. & -XE(1,2)*(XE(2,3)+XE(2,4))) ) * r_z
  190. BB(2,2) = ( XE(1,4)*(XE(1,1)+XE(1,4))
  191. & -XE(1,2)*(XE(1,1)+XE(1,2)) ) * r_z
  192. BB(1,3) = ( XE(2,3)*(XE(1,2)+XE(1,3))-XE(2,1)*(XE(1,2)+XE(1,1))
  193. & +X1s2*( XE(1,4)*(XE(2,3)-XE(2,1))
  194. & +XE(1,1)*(XE(2,3)+XE(2,4))
  195. & -XE(1,3)*(XE(2,4)+XE(2,1))) ) * r_z
  196. BB(2,4) = ( XE(1,1)*(XE(1,2)+XE(1,1))
  197. & -XE(1,3)*(XE(1,3)+XE(1,2)) ) * r_z
  198. BB(1,5) = ( XE(2,4)*(XE(1,3)+XE(1,4))-XE(2,2)*(XE(1,3)+XE(1,2))
  199. & +X1s2*( XE(1,1)*(XE(2,4)-XE(2,2))
  200. & +XE(1,2)*(XE(2,4)+XE(2,1))
  201. & -XE(1,4)*(XE(2,1)+XE(2,2))) ) * r_z
  202. BB(2,6) = ( XE(1,2)*(XE(1,2)+XE(1,3))
  203. & -XE(1,4)*(XE(1,4)+XE(1,3)) ) * r_z
  204. BB(1,7) = ( XE(2,1)*(XE(1,4)+XE(1,1))-XE(2,3)*(XE(1,4)+XE(1,3))
  205. & +X1s2*( XE(1,2)*(XE(2,1)-XE(2,3))
  206. & +XE(1,3)*(XE(2,1)+XE(2,2))
  207. & -XE(1,1)*(XE(2,2)+XE(2,3))) ) * r_z
  208. BB(2,8) = ( XE(1,3)*(XE(1,3)+XE(1,4))
  209. & -XE(1,1)*(XE(1,1)+XE(1,4)) ) * r_z
  210. *- Integration analytique des termes BB(3,1),BB(3,3),BB(3,5),BB(3,7)
  211. BB(3,1) = ( XE(1,1)*(XE(2,2)-XE(2,4))+XE(2,1)*(XE(1,4)-XE(1,2))
  212. & +X1s2*( XE(1,2)*(XE(2,3)+XE(2,4))
  213. & +XE(1,3)*(XE(2,4)-XE(2,2))
  214. & -XE(1,4)*(XE(2,3)+XE(2,2))) ) * r_z
  215. BB(3,3) = ( XE(1,2)*(XE(2,3)-XE(2,1))+XE(2,2)*(XE(1,1)-XE(1,3))
  216. & +X1s2*( XE(1,3)*(XE(2,1)+XE(2,4))
  217. & +XE(1,4)*(XE(2,1)-XE(2,3))
  218. & -XE(1,1)*(XE(2,3)+XE(2,4))) ) * r_z
  219. BB(3,5) = ( XE(1,3)*(XE(2,4)-XE(2,2))+XE(2,3)*(XE(1,2)-XE(1,4))
  220. & +X1s2*( XE(1,4)*(XE(2,1)+XE(2,2))
  221. & +XE(1,1)*(XE(2,2)-XE(2,4))
  222. & -XE(1,2)*(XE(2,4)+XE(2,1))) ) * r_z
  223. BB(3,7) = ( XE(1,4)*(XE(2,1)-XE(2,3))+XE(2,4)*(XE(1,3)-XE(1,1))
  224. & +X1s2*( XE(1,1)*(XE(2,2)+XE(2,3))
  225. & +XE(1,2)*(XE(2,3)-XE(2,1))
  226. & -XE(1,3)*(XE(2,1)+XE(2,2))) ) * r_z
  227. * write (*,*) 'calcul de aire pour bbdil'
  228. * write (*,*) 'aire = ',aire
  229. * write (*,*) 'ecriture de la matrice bb'
  230. * write (*,4) (('bb(',i,',',j,')=',bb(i,j),i=1,3),j=1,2*nbnn)
  231. GOTO 999
  232.  
  233. *-----------------------------------------------------------------------
  234. *----------------------------- Element ICT6 ----------------------------
  235. *-----------------------------------------------------------------------
  236. 30 CONTINUE
  237. * write(*,*) 'Element ICT6',ifour
  238. * write (*,*) 'ecriture de la matrice xe[ ]'
  239. * write (*,3) (('xe(',i,',',j,')=',xe(i,j),i=1,2),j=1,6)
  240. GOTO (666,301,301,303),IFR
  241. GOTO 666
  242. *
  243. *--------contraintes planes ou deformations planes(ifour=-2,-1)
  244. 301 CONTINUE
  245. *--------donnee des composantes de bb-dil
  246. r_z = ( XE(1,1)*(XE(2,2)-XE(2,6)) + XE(1,2)*(XE(2,3)-XE(2,1))
  247. & + XE(1,3)*(XE(2,4)-XE(2,2)) + XE(1,4)*(XE(2,5)-XE(2,3))
  248. & + XE(1,5)*(XE(2,6)-XE(2,4)) + XE(1,6)*(XE(2,1)-XE(2,5)) )
  249. & + X1s4 * ( XE(1,1)*(XE(2,5)-XE(2,3))
  250. & + XE(1,3)*(XE(2,1)-XE(2,5))
  251. & + XE(1,5)*(XE(2,3)-XE(2,1)) )
  252. AIRE = X2s3 * r_z
  253. r_z = xUn / r_z
  254. BB(1, 1) = ( (XE(2,2)-XE(2,6)) + X1s4 * (XE(2,5)-XE(2,3)) ) * r_z
  255. BB(2, 2) = ( (XE(1,6)-XE(1,2)) + X1s4 * (XE(1,3)-XE(1,5)) ) * r_z
  256. BB(1, 3) = (XE(2,3)-XE(2,1)) * r_z
  257. BB(2, 4) = (XE(1,1)-XE(1,3)) * r_z
  258. BB(1, 5) = ( (XE(2,4)-XE(2,2)) + X1s4 * (XE(2,1)-XE(2,5)) ) * r_z
  259. BB(2, 6) = ( (XE(1,2)-XE(1,4)) + X1s4 * (XE(1,5)-XE(1,1)) ) * r_z
  260. BB(1, 7) = (XE(2,5)-XE(2,3)) * r_z
  261. BB(2, 8) = (XE(1,3)-XE(1,5)) * r_z
  262. BB(1, 9) = ( (XE(2,6)-XE(2,4)) + X1s4 * (XE(2,3)-XE(2,1)) ) * r_z
  263. BB(2,10) = ( (XE(1,4)-XE(1,6)) + X1s4 * (XE(1,1)-XE(1,3)) ) * r_z
  264. BB(1,11) = (XE(2,1)-XE(2,5)) * r_z
  265. BB(2,12) = (XE(1,5)-XE(1,1)) * r_z
  266.  
  267. * write (*,*) 'calcul de aire pour bbdil'
  268. * write (*,*) 'aire = ',aire
  269. * write (*,*) 'ecriture de la matrice bb'
  270. * write (*,4) (('bb(',i,',',j,')=',bb(i,j),i=1,3),j=1,2*nbnn)
  271. GOTO 999
  272. *
  273. *--------axisymetriques (ifour=0)
  274. 303 CONTINUE
  275. *--------donnee des composantes de bb-dil
  276. *-----integration numerique des composantes bb-dil------
  277. AIRE = XZer
  278. DO i = 1,nbnn
  279. XNUM1(i) = XZer
  280. XNUM2(i) = XZer
  281. XNUM3(i) = XZer
  282. ENDDO
  283. DO IGAU = 1,NBPGAU
  284. DO i = 1,nbnn
  285. SHP(1,i) = SHPTOT(1,i,IGAU)
  286. SHP(2,i) = SHPTOT(2,i,IGAU)
  287. SHP(3,i) = SHPTOT(3,i,IGAU)
  288. ENDDO
  289. CALL DISTRR(XE,SHP,nbnn,RR)
  290. CALL DISTR2(XE,SHP,nbnn,RR2)
  291. CALL DISTR3(XE,SHP,nbnn,RR3)
  292. CALL DISTZ2(XE,SHP,nbnn,ZZ2)
  293. CALL DISTZ3(XE,SHP,nbnn,ZZ3)
  294. CALL JACOBI(XE,SHP,2,nbnn,DJAC)
  295. r_z = POIGAU(IGAU) * RR
  296. r_zz2 = r_z * ZZ2
  297. r_zz3 = r_z * ZZ3
  298. r_rr2 = r_z * RR2
  299. r_rr3 = r_z * RR3
  300. r_z = POIGAU(IGAU) * DJAC
  301. AIRE = AIRE + (r_z * RR)
  302. DO i = 1,nbnn
  303. XNUM1(i) = XNUM1(i) + ( SHPTOT(2,i,IGAU)*r_zz3
  304. & - SHPTOT(3,i,IGAU)*r_zz2 )
  305. XNUM2(i) = XNUM2(i) + ( SHPTOT(3,i,IGAU)*r_rr2
  306. & - SHPTOT(2,i,IGAU)*r_rr3 )
  307. XNUM3(i) = XNUM3(i) + ( SHPTOT(1,i,IGAU)*r_z )
  308. ENDDO
  309. ENDDO
  310. r_z = XUn / AIRE
  311. DO i = 1,nbnn
  312. k = 2*i
  313. BB(1,k-1) = XNUM1(i) * r_z
  314. BB(2,k) = XNUM2(i) * r_z
  315. BB(3,k-1) = XNUM3(i) * r_z
  316. ENDDO
  317. * write (*,*) 'calcul de aire pour bbdil'
  318. * write (*,*) 'aire = ',aire
  319. * write (*,*) 'ecriture de la matrice bb'
  320. * write (*,4) (('bb(',i,',',j,')=',bb(i,j),i=1,3),j=1,2*nbnn)
  321. GOTO 999
  322.  
  323. *-----------------------------------------------------------------------
  324. *----------------------------- Element ICQ8 ----------------------------
  325. *-----------------------------------------------------------------------
  326. 40 CONTINUE
  327. * write(*,*) 'Element ICQ8',ifour
  328. * write(*,*) 'Ecriture de la matrice xe[ ]'
  329. * write(*,3) (('xe(',i,',',j,')=',xe(i,j),i=1,2),j=1,6)
  330. GOTO (666,401,401,403),IFR
  331. GOTO 666
  332.  
  333. *--------contraintes planes ou deformations planes (ifour=-2,-1)
  334. 401 CONTINUE
  335. *--------donnee de la matrice symetrique p(3,3) (1 fois par element)
  336. P(1,1) = X2s3 * ( XE(1,1)*(XE(2,2)-XE(2,8))
  337. 1 + XE(1,2)*(XE(2,3)-XE(2,1))
  338. 1 +XE(1,3)*(XE(2,4)-XE(2,2))+XE(1,4)*(XE(2,5)-XE(2,3))
  339. 2 +XE(1,5)*(XE(2,6)-XE(2,4))+XE(1,6)*(XE(2,7)-XE(2,5))
  340. 3 +XE(1,7)*(XE(2,8)-XE(2,6))+XE(1,8)*(XE(2,1)-XE(2,7)) )
  341. 4 + X1s6 * ( (XE(1,1)-XE(1,5))*(XE(2,7)-XE(2,3))
  342. 5 +(XE(1,3)-XE(1,7))*(XE(2,1)-XE(2,5)) )
  343. P(1,2) = 5.D0/9.D0*(-XE(2,2)*(XE(1,1)+XE(1,3))
  344. 1 +XE(1,2)*(XE(2,1)+XE(2,3))+XE(1,6)*(-XE(2,5)-XE(2,7))
  345. 1 +XE(2,6)*(XE(1,5)+XE(1,7)))
  346. 2 +4.D0/9.D0*(XE(1,8)*(XE(2,7)+XE(2,2)-XE(2,6)-XE(2,1))
  347. 2 +XE(2,8)*(-XE(1,7)-XE(1,2)+XE(1,6)+XE(1,1))
  348. 2 +XE(1,4)*(XE(2,2)-XE(2,6)+XE(2,5)-XE(2,3))
  349. 2 +XE(2,4)*(-XE(1,2)+XE(1,6)-XE(1,5)+XE(1,3)))
  350. 3 +7.D0/45.D0*(XE(1,2)*(XE(2,5)+XE(2,7))
  351. 3 -XE(2,2)*(XE(1,5)+XE(1,7))-XE(1,6)*(XE(2,1)+XE(2,3))
  352. 3 +XE(2,6)*(XE(1,1)+XE(1,3)))
  353. 4 +8.D0/15.D0*(XE(1,6)*XE(2,2)-XE(1,2)*XE(2,6))
  354. 5 +7.D0/90.D0*(XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  355. 5 +XE(1,5)*XE(2,3)-XE(1,1)*XE(2,7))
  356. 6 +1.D0/30.D0*(-XE(1,7)*XE(2,3)+XE(1,3)*XE(2,7)
  357. 6 -XE(1,5)*XE(2,1)+XE(1,1)*XE(2,5))
  358. P(1,3) = 5.D0/9.D0*(-XE(1,8)*(XE(2,7)+XE(2,1))
  359. 1 +XE(2,8)*(XE(1,7)+XE(1,1))
  360. 1 +XE(1,4)*(XE(2,3)+XE(2,5))
  361. 1 -XE(2,4)*(XE(1,3)+XE(1,5)))
  362. 2 +4.D0/9.D0*((XE(1,8)-XE(1,4))*(XE(2,2)+XE(2,6))
  363. 2 +(-XE(2,8)+XE(2,4))*(XE(1,2)+XE(1,6))
  364. 2 +XE(1,2)*(XE(2,1)-XE(2,3))+XE(2,2)*(-XE(1,1)+XE(1,3))
  365. 2 +XE(1,6)*(XE(2,7)-XE(2,5))+XE(2,6)*(-XE(1,7)+XE(1,5)))
  366. 3 +7.D0/45.D0*(-XE(1,8)*(XE(2,3)+XE(2,5))
  367. 3 +XE(2,8)*(XE(1,3)+XE(1,5))
  368. 3 +XE(1,4)*(XE(2,1)+XE(2,7))
  369. 3 -XE(2,4)*(XE(1,1)+XE(1,7)))
  370. 4 +1.D0/30.D0*(-XE(1,7)*XE(2,3)+XE(1,3)*XE(2,7)
  371. 4 +XE(1,5)*XE(2,1)-XE(1,1)*XE(2,5))
  372. 5 +7.D0/90.D0*(XE(1,7)*XE(2,5)-XE(1,3)*XE(2,1)
  373. 5 -XE(1,5)*XE(2,7)+XE(1,1)*XE(2,3))
  374. 6 +8.D0/15.D0*(XE(1,8)*XE(2,4)-XE(1,4)*XE(2,8))
  375. P(1,4) = XZer
  376.  
  377. P(2,1) = P(1,2)
  378. P(2,2) = 16.D0/45.D0*(XE(2,6)*(XE(1,5)-XE(1,7))
  379. 1 +XE(1,6)*(XE(2,7)-XE(2,5))+XE(1,2)*(XE(2,3)-XE(2,1))
  380. 1 +XE(2,2)*(XE(1,1)-XE(1,3)))
  381. 2 +14.D0/45.D0*(XE(2,4)*(XE(1,3)-XE(1,5))
  382. 2 +XE(1,4)*(XE(2,5)-XE(2,3))+XE(1,8)*(XE(2,1)-XE(2,7))
  383. 2 +XE(2,8)*(XE(1,7)-XE(1,1)))
  384. 3 +8.D0/45.D0*(XE(1,4)*(XE(2,2)-XE(2,6))
  385. 3 +XE(1,8)*(XE(2,6)-XE(2,2))+XE(1,2)*(XE(2,8)-XE(2,4))
  386. 3 +XE(1,6)*(XE(2,4)-XE(2,8)))
  387. 4 +2.D0/45.D0*(XE(2,2)*(XE(1,5)-XE(1,7))
  388. 4 +XE(1,2)*(XE(2,7)-XE(2,5)) +XE(1,6)*(XE(2,3)-XE(2,1))
  389. 4 +XE(2,6)*(XE(1,1)-XE(1,3)))
  390. 5 +4.D0/45.D0*(XE(2,4)*(XE(1,1)-XE(1,7))
  391. 5 +XE(1,4)*(XE(2,7)-XE(2,1)) +XE(1,8)*(XE(2,3)-XE(2,5))
  392. 5 +XE(2,8)*(XE(1,5)-XE(1,3)))
  393. 6 +17.D0/90.D0*(XE(1,7)*XE(2,5)+XE(1,3)*XE(2,1)
  394. 6 -XE(1,5)*XE(2,7)-XE(1,1)*XE(2,3))
  395. 7 +1.D0/90.D0*(-XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  396. 7 +XE(1,5)*XE(2,3)+XE(1,1)*XE(2,7))
  397. P(2,3) = 1.D0/3.D0*(XE(1,5)*(XE(2,6)-XE(2,4))
  398. 1 +XE(1,8)*(XE(2,7)+XE(2,1))+XE(1,7)*(XE(2,6)-XE(2,8))
  399. 1 -XE(1,2)*(XE(2,1)+XE(2,3))+XE(1,1)*(XE(2,2)-XE(2,8))
  400. 1 +XE(1,4)*(XE(2,5)+XE(2,3))-XE(1,6)*(XE(2,7)+XE(2,5))
  401. 1 +XE(1,3)*(XE(2,2)-XE(2,4)))
  402. 2 +4.D0/9.D0*(-XE(1,4)*(XE(2,2)+XE(2,6))
  403. 2 -XE(1,8)*(XE(2,6)+XE(2,2))+XE(1,2)*(XE(2,8)+XE(2,4))
  404. 2 +XE(1,6)*(XE(2,4)+XE(2,8)))
  405. 3 +1.D0/9.D0*(XE(1,7)*(XE(2,2)-XE(2,4))
  406. 3 +XE(1,8)*(XE(2,3)+XE(2,5))
  407. 3 +XE(1,5)*(XE(2,2)-XE(2,8))+XE(1,3)*(XE(2,6)-XE(2,8))
  408. 3 -XE(1,2)*(XE(2,5)+XE(2,7))+XE(1,1)*(XE(2,6)-XE(2,4))
  409. 3 +XE(1,4)*(XE(2,1)+XE(2,7))-XE(1,6)*(XE(2,1)+XE(2,3)))
  410. P(2,4) = XZer
  411.  
  412. P(3,1) = P(1,3)
  413. P(3,2) = P(2,3)
  414. P(3,3) = 14.D0/45.D0*(XE(1,6)*(XE(2,7)-XE(2,5))
  415. 1 +XE(2,6)*(XE(1,5)-XE(1,7))+XE(1,2)*(XE(2,3)-XE(2,1))
  416. 1 +XE(2,2)*(XE(1,1)-XE(1,3)))
  417. 2 +16.D0/45.D0*(XE(1,8)*(XE(2,1)-XE(2,7))
  418. 2 +XE(2,8)*(XE(1,7)-XE(1,1))+XE(1,4)*(XE(2,5)-XE(2,3))
  419. 2 +XE(2,4)*(XE(1,3)-XE(1,5)))
  420. 3 +8.D0/45.D0*(XE(1,4)*(XE(2,2)-XE(2,6))
  421. 3 +XE(1,8)*(XE(2,6)-XE(2,2))+XE(1,2)*(XE(2,8)-XE(2,4))
  422. 3 +XE(1,6)*(XE(2,4)-XE(2,8)))
  423. 4 +2.D0/45.D0*(XE(2,4)*(XE(1,7)-XE(1,1))
  424. 4 +XE(1,8)*(XE(2,5)-XE(2,3))+XE(2,8)*(-XE(1,5)+XE(1,3))
  425. 4 +XE(1,4)*(XE(2,1)-XE(2,7)))
  426. 5 +4.D0/45.D0*(XE(2,2)*(XE(1,7)-XE(1,5))
  427. 5 +XE(1,2)*(XE(2,5)-XE(2,7))+XE(1,6)*(XE(2,1)-XE(2,3))
  428. 5 +XE(2,6)*(XE(1,3)-XE(1,1)))
  429. 6 +1.D0/90.D0*(-XE(1,5)*XE(2,7)+XE(1,3)*XE(2,1)
  430. 6 +XE(1,7)*XE(2,5)-XE(1,1)*XE(2,3))
  431. 7 +17.D0/90.D0*(-XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  432. 7 +XE(1,5)*XE(2,3)+XE(1,1)*XE(2,7))
  433. P(3,4) = XZer
  434.  
  435. P(4,1) = XZer
  436. P(4,2) = XZer
  437. P(4,3) = XZer
  438. P(4,4) = XZer
  439.  
  440. * write (*,*) 'ecriture de la matrice p[ ]'
  441. * write (*,4) (('p(',i,',',j,')=',p(i,j),i=1,3),j=1,3)
  442.  
  443. *-----------------donnee des vecteurs {t}={t1,t2,t3}--------------------
  444. A(1,1) = 2.D0/3.D0*(XE(2,2)-XE(2,8))
  445. 1 +1.D0/6.D0*(XE(2,7)-XE(2,3))
  446. A(2,1) = 1.D0/9.D0*(4.D0*XE(2,8)-5.D0*XE(2,2))
  447. 1 +7.D0/90.D0*(-XE(2,7)+2.D0*XE(2,6))
  448. 1 +1.D0/30.D0*XE(2,5)
  449. A(3,1) = 1.D0/9.D0*(-4.D0*XE(2,2)+5.D0*XE(2,8))
  450. 1 +7.D0/90.D0*(XE(2,3)-2.D0*XE(2,4))
  451. 1 -1.D0/30.D0*XE(2,5)
  452.  
  453. A(1,2) = 2.D0/3.D0*(XE(1,8)-XE(1,2))
  454. 1 +1.D0/6.D0*(XE(1,3)-XE(1,7))
  455. A(2,2) = 1.D0/9.D0*(-4.D0*XE(1,8)+5.D0*XE(1,2))
  456. 1 +7.D0/90.D0*(XE(1,7)-2.D0*XE(1,6))
  457. 1 -1.D0/30.D0*XE(1,5)
  458. A(3,2) = 1.D0/9.D0*(4.D0*XE(1,2)-5.D0*XE(1,8))
  459. 1 +7.D0/90.D0*(-XE(1,3)+2.D0*XE(1,4))
  460. 1 +1.D0/30.D0*XE(1,5)
  461.  
  462. A(1,3) = 2.D0/3.D0*(-XE(2,1)+XE(2,3))
  463. A(2,3) = 5.D0/9.D0*(XE(2,1)+XE(2,3))
  464. 1 +7.D0/45.D0*(XE(2,5)+XE(2,7))
  465. 1 -4.D0/9.D0*(XE(2,4)+XE(2,8))
  466. 1 -8.D0/15.D0*XE(2,6)
  467. A(3,3) = 4.D0/9.D0*(XE(2,1)-XE(2,3)+XE(2,4)-XE(2,8))
  468.  
  469. A(1,4) = 2.D0/3.D0*(-XE(1,3)+XE(1,1))
  470. A(2,4) = -5.D0/9.D0*(XE(1,1)+XE(1,3))
  471. 1 -7.D0/45.D0*(XE(1,5)+XE(1,7))
  472. 1 +4.D0/9.D0*(XE(1,4)+XE(1,8))
  473. 1 +8.D0/15.D0*XE(1,6)
  474. A(3,4) = 4.D0/9.D0*(-XE(1,1)+XE(1,3)-XE(1,4)+XE(1,8))
  475.  
  476. A(1,5) = 2.D0/3.D0*(XE(2,4)-XE(2,2))
  477. 1 +1.D0/6.D0*(-XE(2,5)+XE(2,1))
  478. A(2,5) = 1.D0/9.D0*(4.D0*XE(2,4)-5.D0*XE(2,2))
  479. 1 +7.D0/90.D0*(-XE(2,5)+2.D0*XE(2,6))
  480. 1 +1.D0/30.D0*XE(2,7)
  481. A(3,5) = 1.D0/9.D0*(4.D0*XE(2,2)-5.D0*XE(2,4))
  482. 1 +7.D0/90.D0*(-XE(2,1)+2.D0*XE(2,8))
  483. 1 +1.D0/30.D0*XE(2,7)
  484.  
  485. A(1,6) = 2.D0/3.D0*(-XE(1,4)+XE(1,2))
  486. 1 +1.D0/6.D0*(XE(1,5)-XE(1,1))
  487. A(2,6) = 1.D0/9.D0*(-4.D0*XE(1,4)+5.D0*XE(1,2))
  488. 1 +7.D0/90.D0*(XE(1,5)-2.D0*XE(1,6))
  489. 1 -1.D0/30.D0*XE(1,7)
  490. A(3,6) = 1.D0/9.D0*(-4.D0*XE(1,2)+5.D0*XE(1,4))
  491. 1 +7.D0/90.D0*(XE(1,1)-2.D0*XE(1,8))
  492. 1 -1.D0/30.D0*XE(1,7)
  493.  
  494. A(1,7) = 2.D0/3.D0*(-XE(2,3)+XE(2,5))
  495. A(2,7) = 4.D0/9.D0*(XE(2,5)-XE(2,3)+XE(2,2)-XE(2,6))
  496. A(3,7) = 5.D0/9.D0*(XE(2,3)+XE(2,5))
  497. 1 +7.D0/45.D0*(XE(2,1)+XE(2,7))
  498. 1 -4.D0/9.D0*(XE(2,2)+XE(2,6))
  499. 1 -8.D0/15.D0*XE(2,8)
  500.  
  501. A(1,8) = 2.D0/3.D0*(XE(1,3)-XE(1,5))
  502. A(2,8) = 4.D0/9.D0*(-XE(1,5)+XE(1,3)-XE(1,2)+XE(1,6))
  503. A(3,8) = -5.D0/9.D0*(XE(1,3)+XE(1,5))
  504. 1 -7.D0/45.D0*(XE(1,1)+XE(1,7))
  505. 1 +4.D0/9.D0*(XE(1,2)+XE(1,6))
  506. 1 +8.D0/15.D0*XE(1,8)
  507.  
  508. A(1,9) = 2.D0/3.D0*(-XE(2,4)+XE(2,6))
  509. 1 +1.D0/6.D0*(XE(2,3)-XE(2,7))
  510. A(2,9) = 1.D0/9.D0*(-4.D0*XE(2,4)+5.D0*XE(2,6))
  511. 1 +7.D0/90.D0*(XE(2,3)-2.D0*XE(2,2))
  512. 1 -1.D0/30.D0*XE(2,1)
  513. A(3,9) = 1.D0/9.D0*(4.D0*XE(2,6)-5.D0*XE(2,4))
  514. 1 +7.D0/90.D0*(-XE(2,7)+2.D0*XE(2,8))
  515. 1 +1.D0/30.D0*XE(2,1)
  516.  
  517. A(1,10) = 2.D0/3.D0*(XE(1,4)-XE(1,6))
  518. 1 +1.D0/6.D0*(-XE(1,3)+XE(1,7))
  519. A(2,10) = 1.D0/9.D0*(4.D0*XE(1,4)-5.D0*XE(1,6))
  520. 1 +7.D0/90.D0*(-XE(1,3)+2.D0*XE(1,2))
  521. 1 +1.D0/30.D0*XE(1,1)
  522. A(3,10) = 1.D0/9.D0*(-4.D0*XE(1,6)+5.D0*XE(1,4))
  523. 1 +7.D0/90.D0*(XE(1,7)-2.D0*XE(1,8))
  524. 1 -1.D0/30.D0*XE(1,1)
  525.  
  526. A(1,11) = 2.D0/3.D0*(-XE(2,5)+XE(2,7))
  527. A(2,11) = -5.D0/9.D0*(XE(2,7)+XE(2,5))
  528. 1 -7.D0/45.D0*(XE(2,1)+XE(2,3))
  529. 1 +4.D0/9.D0*(XE(2,4)+XE(2,8))
  530. 1 +8.D0/15.D0*XE(2,2)
  531. A(3,11) = 4.D0/9.D0*(XE(2,4)-XE(2,5)-XE(2,8)+XE(2,7))
  532.  
  533. A(1,12) = 2.D0/3.D0*(XE(1,5)-XE(1,7))
  534. A(2,12) = 5.D0/9.D0*(XE(1,7)+XE(1,5))
  535. 1 +7.D0/45.D0*(XE(1,1)+XE(1,3))
  536. 1 -4.D0/9.D0*(XE(1,4)+XE(1,8))
  537. 1 -8.D0/15.D0*XE(1,2)
  538. A(3,12) = 4.D0/9.D0*(-XE(1,4)+XE(1,5)+XE(1,8)-XE(1,7))
  539.  
  540. A(1,13) = 2.D0/3.D0*(-XE(2,6)+XE(2,8))
  541. 1 +1.D0/6.D0*(XE(2,5)-XE(2,1))
  542. A(2,13) = 1.D0/9.D0*(-4.D0*XE(2,8)+5.D0*XE(2,6))
  543. 1 +7.D0/90.D0*(XE(2,1)-2.D0*XE(2,2))
  544. 1 -1.D0/30.D0*XE(2,3)
  545. A(3,13) = 1.D0/9.D0*(-4.D0*XE(2,6)+5.D0*XE(2,8))
  546. 1 +7.D0/90.D0*(XE(2,5)-2.D0*XE(2,4))
  547. 1 -1.D0/30.D0*XE(2,3)
  548.  
  549. A(1,14) = 2.D0/3.D0*(XE(1,6)-XE(1,8))
  550. 1 +1.D0/6.D0*(-XE(1,5)+XE(1,1))
  551. A(2,14) = 1.D0/9.D0*(4.D0*XE(1,8)-5.D0*XE(1,6))
  552. 1 +7.D0/90.D0*(-XE(1,1)+2.D0*XE(1,2))
  553. 1 +1.D0/30.D0*XE(1,3)
  554. A(3,14) = 1.D0/9.D0*(4.D0*XE(1,6)-5.D0*XE(1,8))
  555. 1 +7.D0/90.D0*(-XE(1,5)+2.D0*XE(1,4))
  556. 1 +1.D0/30.D0*XE(1,3)
  557.  
  558. A(1,15) = 2.D0/3.D0*(-XE(2,7)+XE(2,1))
  559. A(2,15) = 4.D0/9.D0*(-XE(2,6)+XE(2,7)+XE(2,2)-XE(2,1))
  560. A(3,15) = -5.D0/9.D0*(XE(2,1)+XE(2,7))
  561. 1 -7.D0/45.D0*(XE(2,3)+XE(2,5))
  562. 1 +4.D0/9.D0*(XE(2,2)+XE(2,6))
  563. 1 +8.D0/15.D0*XE(2,4)
  564.  
  565. A(1,16) = 2.D0/3.D0*(XE(1,7)-XE(1,1))
  566. A(2,16) = 4.D0/9.D0*(XE(1,6)-XE(1,7)-XE(1,2)+XE(1,1))
  567. A(3,16) = 5.D0/9.D0*(XE(1,1)+XE(1,7))
  568. 1 +7.D0/45.D0*(XE(1,3)+XE(1,5))
  569. 1 -4.D0/9.D0*(XE(1,2)+XE(1,6))
  570. 1 -8.D0/15.D0*XE(1,4)
  571.  
  572. * write (*,*) 'ecriture de la matrice t[ ]'
  573. * write (*,4) (('t(',i,',',j,')=',a(i,j),i=1,3),j=1,16)
  574. *--------------resolution matricielle de [p]{a}={t}---------------------
  575. * write (*,*) 'Appel a GAUSSJ'
  576. N = 3
  577. NP = 4
  578. M = 16
  579. MP = 60
  580. CALL GAUSSJ(P,N,NP,A,M,MP)
  581. GOTO 999
  582.  
  583. *--------axisymetriques (ifour=0)
  584. 403 CONTINUE
  585. *--------donnee de la matrice symetrique p(3,3) (1 fois par element)
  586. CALL ZERO(P,4,4)
  587. DO IGAU = 1,NBPGAU
  588. DO I = 1,nbnn
  589. SHP(1,I) = SHPTOT(1,I,IGAU)
  590. SHP(2,I) = SHPTOT(2,I,IGAU)
  591. SHP(3,I) = SHPTOT(3,I,IGAU)
  592. ENDDO
  593. CALL DISTRR(XE,SHP,nbnn,RR)
  594. CALL JACOBI(XE,SHP,2,nbnn,DJAC)
  595. r_z = POIGAU(IGAU)*RR*DJAC
  596. P(1,1) = P(1,1) + r_z
  597. P(2,1) = P(2,1) + (r_z * QSIGAU(IGAU))
  598. P(3,1) = P(3,1) + (r_z * ETAGAU(IGAU))
  599. P(2,2) = P(2,2) + (r_z * QSIGAU(IGAU) * QSIGAU(IGAU))
  600. P(3,2) = P(3,2) + (r_z * QSIGAU(IGAU) * ETAGAU(IGAU))
  601. P(3,3) = P(3,3) + (r_z * ETAGAU(IGAU) * ETAGAU(IGAU))
  602. ENDDO
  603. P(1,2) = P(2,1)
  604. P(1,3) = P(3,1)
  605. P(2,3) = P(3,2)
  606. * write (*,*) 'ecriture de la matrice p[ ]'
  607. * write (*,4) (('p(',i,',',j,')=',p(i,j),i=1,3),j=1,3)
  608. *-----------calcul des vecteurs {t}={t1,t2,t3}--integration numerique---
  609. CALL ZERO(A,4,24)
  610. DO 4031 IGAU = 1,NBPGAU
  611. DO I = 1,nbnn
  612. SHP(1,I) = SHPTOT(1,I,IGAU)
  613. SHP(2,I) = SHPTOT(2,I,IGAU)
  614. SHP(3,I) = SHPTOT(3,I,IGAU)
  615. ENDDO
  616. CALL DISTRR(XE,SHP,nbnn,RR)
  617. CALL DISTR2(XE,SHP,nbnn,RR2)
  618. CALL DISTR3(XE,SHP,nbnn,RR3)
  619. CALL DISTZ2(XE,SHP,nbnn,ZZ2)
  620. CALL DISTZ3(XE,SHP,nbnn,ZZ3)
  621. CALL JACOBI(XE,SHP,2,nbnn,DJAC)
  622. K = 0
  623. DO I = 1,nbnn
  624. K = K+1
  625. r_z = POIGAU(IGAU)*RR
  626. & *(SHPTOT(2,I,IGAU)*ZZ3-SHPTOT(3,I,IGAU)*ZZ2)
  627. A(1,K) = A(1,K) + r_z
  628. A(2,K) = A(2,K) + r_z * QSIGAU(IGAU)
  629. A(3,K) = A(3,K) + r_z * ETAGAU(IGAU)
  630. K = K+1
  631. r_z = POIGAU(IGAU)*RR
  632. & *(-SHPTOT(2,I,IGAU)*RR3+SHPTOT(3,I,IGAU)*RR2)
  633. A(1,K) = A(1,K) + r_z
  634. A(2,K) = A(2,K) + r_z * QSIGAU(IGAU)
  635. A(3,K) = A(3,K) + r_z * ETAGAU(IGAU)
  636. K = K+1
  637. r_z = POIGAU(IGAU)*SHPTOT(1,I,IGAU)*DJAC
  638. A(1,K) = A(1,K) + r_z
  639. A(2,K) = A(2,K) + r_z * QSIGAU(IGAU)
  640. A(3,K) = A(3,K) + r_z * ETAGAU(IGAU)
  641. ENDDO
  642. 4031 CONTINUE
  643. * write(*,*) 'Ecriture de la matrice t[ ]'
  644. * write(*,4) (('t(',i,',',j,')=',a(i,j),i=1,3),j=1,24)
  645. *------------resolution matricielle de [p]{a}={t}-----------------
  646. N = 3
  647. NP = 4
  648. M = 24
  649. MP = 60
  650. * write (*,*) 'appel a GAUSSJ'
  651. CALL GAUSSJ(P,N,NP,A,M,MP)
  652. * write(*,*) 'Ecriture de la matrice a[ ]'
  653. * write(*,4) (('a(',i,',',j,')=',a(i,j),i=1,3),j=1,24)
  654. GOTO 999
  655.  
  656. C=======================================================================
  657. C========== Elements MASSIFS INCOMPRESSIBLES TRIDIMENSIONNELS ==========
  658. C=======================================================================
  659. 100 CONTINUE
  660. IF (ifour.NE.2) GOTO 666
  661.  
  662. DIM3 = 1.D0
  663. FACAR = 1.D0
  664. FACSCA = 1.D0
  665. ESTEL = XZero
  666.  
  667. C= Boucle sur les points d'integration
  668. DO iGau=1,NBPGAU
  669.  
  670. * BGR au point IGAU
  671. r_z = Xzer
  672. i_z = 0
  673. CALL BGRMAS(iGau,MELE,NBNN,LRE,IFOUR,NGRA,NHRM,XE,
  674. & r_z,SHPTOT,SHP,BU,BGR,DJAC,i_z)
  675.  
  676. C= Calcul de la composante integree en ce point de Gauss
  677. DJAC=ABS(DJAC)*POIGAU(iGau)*FACAR*DIM3
  678. ESTEL=ESTEL+FACSCA*DJAC
  679.  
  680. *----- Element ICQ8 ICCU20(76) ICTE10(77) ICPR15(78) ICPY13(274)
  681. IF (MELE.EQ.72 .or. (MELE.ge.76.and.MELE.le.78) .or.
  682. & MELE.EQ.274) then
  683. * second membre T
  684. K = 1
  685. jj = 0
  686. DO i = 1,NBNN
  687. jj = jj + 1
  688. A(1,jj) = A(1,jj) + BGR(1,K)*DJAC
  689. A(2,jj) = A(2,jj) + BGR(1,K)*qsigau(igau)*DJAC
  690. A(3,jj) = A(3,jj) + BGR(1,K)*etagau(igau)*DJAC
  691. if (mele.ge.76)
  692. & A(4,jj) = A(4,jj) + BGR(1,K)*dzegau(igau)*DJAC
  693. jj = jj + 1
  694. A(1,jj) = A(1,jj) + BGR(5,K+1)*DJAC
  695. A(2,jj) = A(2,jj) + BGR(5,K+1)*qsigau(igau)*DJAC
  696. A(3,jj) = A(3,jj) + BGR(5,K+1)*etagau(igau)*DJAC
  697. if (mele.ge.76) then
  698. A(4,jj) = A(4,jj) + BGR(5,K+1)*dzegau(igau)*DJAC
  699. jj = jj + 1
  700. A(1,jj) = A(1,jj) + BGR(9,K+2)*DJAC
  701. A(2,jj) = A(2,jj) + BGR(9,K+2)*qsigau(igau)*DJAC
  702. A(3,jj) = A(3,jj) + BGR(9,K+2)*etagau(igau)*DJAC
  703. A(4,jj) = A(4,jj) + BGR(9,K+2)*dzegau(igau)*DJAC
  704. endif
  705. K = K + KINC
  706. ENDDO
  707. * matrice M
  708. P(1,1) = P(1,1) + DJAC
  709. P(1,2) = P(1,2) + qsigau(igau)*DJAC
  710. P(1,3) = P(1,3) + etagau(igau)*DJAC
  711. P(2,2) = P(2,2) + qsigau(igau)*qsigau(igau)*DJAC
  712. P(2,3) = P(2,3) + qsigau(igau)*etagau(igau)*DJAC
  713. P(3,3) = P(3,3) + etagau(igau)*etagau(igau)*DJAC
  714. if (mele.ge.76) then
  715. P(1,4) = P(1,4) + dzegau(igau)*DJAC
  716. P(2,4) = P(2,4) + qsigau(igau)*dzegau(igau)*DJAC
  717. P(3,4) = P(3,4) + etagau(igau)*dzegau(igau)*DJAC
  718. P(4,4) = P(4,4) + dzegau(igau)*dzegau(igau)*DJAC
  719. endif
  720.  
  721. else if(mele.le.71) then
  722.  
  723. K = 1
  724. DO i = 1,NBNN
  725. bb(1,K) = bb(1,K) + BGR(1,K)*DJAC
  726. bb(2,K+1) = bb(2,K+1) + BGR(5,K+1)*DJAC
  727. bb(3,K) = bb(3,K) + BGR(9,K)*DJAC
  728. K = K + KINC
  729. ENDDO
  730.  
  731. else if ( (mele.ge.73.and.mele.le.75)
  732. &.or.mele.eq.273) then
  733.  
  734. K = 1
  735. DO i = 1,NBNN
  736. bb(1,K) = bb(1,K) + BGR(1,K)*DJAC
  737. bb(2,K+1) = bb(2,K+1) + BGR(5,K+1)*DJAC
  738. bb(3,K+2) = bb(3,K+2) + BGR(9,K+2)*DJAC
  739. K = K + KINC
  740. ENDDO
  741.  
  742. endif
  743.  
  744. ENDDO
  745.  
  746. if (MELE.EQ.72) then
  747. P(1,4) = XZer
  748. P(2,1) = P(1,2)
  749. P(2,4) = XZer
  750. P(3,1) = P(1,3)
  751. P(3,2) = P(2,3)
  752. P(3,4) = XZer
  753.  
  754. P(4,1) = XZer
  755. P(4,2) = XZer
  756. P(4,3) = XZer
  757. P(4,4) = XZer
  758.  
  759. ELSE IF (mele.GE.76) THEN
  760. P(2,1) = P(1,2)
  761. P(3,1) = P(1,3)
  762. P(3,2) = P(2,3)
  763. P(4,1) = P(1,4)
  764. P(4,2) = P(2,4)
  765. P(4,3) = P(3,4)
  766. ENDIF
  767. *
  768. ** synthese
  769. *
  770. if (MELE.EQ.72) then
  771. N = 3
  772. NP = 4
  773. M = 16
  774. MP = 60
  775. * write (*,*) 'appel a GAUSSJ'
  776. CALL GAUSSJ(P,N,NP,A,M,MP)
  777. * write(*,*) 'Ecriture de la matrice a[ ]'
  778. * write(*,4) (('a(',i,',',j,')=',a(i,j),i=1,3),j=1,24)
  779.  
  780. elseif (mele.ge.76.and.mele.ne.273) then
  781. N = 4
  782. NP = 4
  783. M = NBNN*3
  784. MP = 60
  785. * write (*,*) 'appel a GAUSSJ'
  786. CALL GAUSSJ(P,N,NP,A,M,MP)
  787.  
  788. elseif(mele.le.71) then
  789.  
  790. K = 1
  791. DO i = 1,NBNN
  792. bb(1,K) = bb(1,K)/ESTEL
  793. bb(2,K+1) = bb(2,K+1)/ESTEL
  794. bb(3,K) = bb(3,K)/ESTEL
  795. K = K + KINC
  796. ENDDO
  797.  
  798. elseif((mele.ge.73.and.mele.le.75).or.
  799. &mele.eq.273) then
  800.  
  801. K = 1
  802. DO i = 1,NBNN
  803. bb(1,K) = bb(1,K)/ESTEL
  804. bb(2,K+1) = bb(2,K+1)/ESTEL
  805. bb(3,K+2) = bb(3,K+2)/ESTEL
  806. K = K + KINC
  807. ENDDO
  808.  
  809. endif
  810.  
  811. GOTO 999
  812.  
  813. C=======================================================================
  814. C======================= ERREUR : Cas non prevus =======================
  815. C=======================================================================
  816. 666 CONTINUE
  817. * write(6,*) 'Erreur d aiguillage - cas non prevu',MELE,IFOUR
  818. CALL ERREUR(5)
  819.  
  820. 999 CONTINUE
  821. * write(6,*) 'Sortie de BBCAL3'
  822.  
  823. c RETURN
  824. END
  825.  
  826.  
  827.  

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