Télécharger bcoq2.eso

Retour à la liste

Numérotation des lignes :

  1. C BCOQ2 SOURCE CHAT 06/03/29 21:15:33 5360
  2. SUBROUTINE BCOQ2(B,NSTRS,DJAC,IGAU,IFOU,XEL,NN,T,P,EXCEN,DIM3,
  3. . IARR,XDPGE,YDPGE)
  4. C==================================================================
  5. C CALCUL DE LA MATRICE B DES COQUES @ 2 NOEUDS
  6. C ROUTINE FORTRAN PUR
  7. C GELE JANVIER 87
  8. C==================================================================
  9. C ENTREES
  10. C IGAU=NUMERO DU POINT DE GAUSS
  11. C IFOU=IFOUR DE CCOPTIO
  12. C XEL=COORDONNEES LOCALE DE L'ELEMENT
  13. C NN=NUMERO DU MODE DE FOURIER
  14. C T(IGAU)=POSITION DU POINT DE GAUSS
  15. C P(IGAU)=POIDS DU POINT DE GAUSS
  16. C EXCEN = EXCENTREMENT
  17. C DIM3 = EPAISSEUR DANS L'AUTRE DIMENSION
  18. C XDPGE,YDPGE : COORDONNEE DU POINT AUTOUR DUQUEL
  19. C FAIT LE MOUVEMENT EN DEFO PLAN GENE
  20. C SORTIE
  21. C B(6,8)=MATRICE B AU POINT DE GAUSSPOUR IFOU GT 0
  22. C B(4,6)=MATRICE B AU POINT DE GAUSSPOUR IFOU LE 0
  23. C B(4,9)=MATRICE B AU POINT DE GAUSSPOUR IFOU EQ -3
  24. C DJAC=JACOBIEN AU POINT DE GAUSS=POIGAU*LONG/2 (*R(IGAU), SI
  25. C IFOU EST SUPERIEUR OU EGAL A ZERO)
  26. C IARR=0 SI OK 1 SI LONGUEUR ELEMENT NULLE
  27. C 2 SI R / D INFERIEUR A 10-3
  28. C==================================================================
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. C Include contenant quelques constantes dont XPI, XZERO :
  32. -INC CCREEL
  33. PARAMETER(UNDE=.5D0,UN=1.D0,DEUX=2.D0,TRS=3.D0)
  34. PARAMETER(QUTR=4.D0,SIX=6.D0,DOUZ=12.D0)
  35. DIMENSION B(NSTRS,*),T(*),XEL(3,*),P(*)
  36. C
  37. C ---------------------------------INITIALISATION
  38. IARR=0
  39. DJAC=XZERO
  40. IF(IFOU.GT.0) THEN
  41. LRE=8
  42. CALL ZERO(B,6,8)
  43. ELSE IF(IFOU.LE.0) THEN
  44. LRE=6
  45. CALL ZERO(B,4,6)
  46. IF(IFOU.EQ.-3) THEN
  47. LRE=9
  48. CALL ZERO(B,4,9)
  49. ENDIF
  50. ENDIF
  51. C
  52. D=SQRT((XEL(1,2)-XEL(1,1))**2+(XEL(2,2)-XEL(2,1))**2)
  53. IF(D.EQ.0) THEN
  54. IARR=1
  55. GOTO 4
  56. ENDIF
  57. DD=UN/D
  58. RO=(XEL(1,1)+XEL(1,2))*UNDE
  59. R1=(XEL(2,1)+XEL(2,2))*UNDE
  60. SP=(XEL(1,2)-XEL(1,1))/D
  61. CP=(XEL(2,2)-XEL(2,1))/D
  62. SP2=SP*SP
  63. CP2=CP*CP
  64. SPCP=SP*CP
  65. C X FONCTION FORME NOEUD 2 RRRR RAYON
  66. C Y FONCTION FORME NOEUD 1 D LONGUEUR DD INVERSE LONGUEUR
  67. X=UNDE+UNDE*T(IGAU)
  68. Y=UNDE-UNDE*T(IGAU)
  69. RRRR=RO+UNDE*D*SP*T(IGAU)
  70. C ---------------------------------
  71. C
  72. C TEST D'ERREUR
  73. C
  74. IF(IFOU.GE.0) THEN
  75. IF(ABS(RRRR/D).LE.1.D-03) THEN
  76. IARR=2
  77. GOTO 4
  78. ENDIF
  79. ENDIF
  80. C
  81. C ---------------------------------CALCULS
  82. C
  83. IF(IFOU.LT.0) RRRR =UN
  84. U=X/RRRR
  85. V=Y/RRRR
  86. C
  87. C AXISYMETRIQUE DEFORMATIONS PLANES CONTRAINTES PLANES
  88. C
  89. IF(IFOU.LE.0) THEN
  90. C
  91. C EPSILON S S
  92. C
  93. B(1,1)=-SP*DD
  94. B(1,2)=-CP*DD
  95. B(1,4)=-B(1,1)
  96. B(1,5)=-B(1,2)
  97. C
  98. C KSI S S
  99. C
  100. AUX = SIX*T(IGAU)*DD*DD
  101. B(3,1)= CP*AUX
  102. B(3,2)=-SP*AUX
  103. B(3,3)=(QUTR-SIX*X)*DD
  104. B(3,4)=-B(3,1)
  105. B(3,5)=-B(3,2)
  106. B(3,6)=(DEUX-SIX*X)*DD
  107. C
  108. C MODIFICATION DEFORMATION PLANE GENERALISEE
  109. C
  110. IF (IFOU.EQ.-3) THEN
  111. RRRX=RO+UNDE*D*SP*T(IGAU)
  112. RRRY=R1+UNDE*D*CP*T(IGAU)
  113. B(2,7 )=UN
  114. B(2,8)=XDPGE-RRRX
  115. B(2,9)=RRRY-YDPGE
  116. B(4,8)=CP
  117. B(4,9)=SP
  118. ENDIF
  119. C
  120. C AXISYMETRIQUE
  121. C
  122. IF(IFOU.EQ.0) THEN
  123. C
  124. C EPSILON THETA THETA
  125. C
  126. B(2,1)= V*(SP2+CP2*Y*(UN+DEUX*X))
  127. B(2,2)= SPCP*U*Y*T(IGAU)
  128. B(2,3)=-D*CP*X*Y*V
  129. B(2,4)= U*(SP2+CP2*X*(TRS-DEUX*X))
  130. B(2,5)=-B(2,2)
  131. B(2,6)= D*CP*X*Y*U
  132. C
  133. C KSI THETA THETA
  134. C
  135. AUX =-SIX*U*Y*SP*DD
  136. B(4,1)= CP*AUX
  137. B(4,2)=-SP*AUX
  138. B(4,3)= SP*V*(TRS*X-UN)
  139. B(4,4)=-CP*AUX
  140. B(4,5)= SP*AUX
  141. B(4,6)=-SP*U*(TRS*X-DEUX)
  142. ENDIF
  143. C
  144. C FOURIER
  145. C
  146. ELSE IF(IFOU.GT.0) THEN
  147. AN=DBLE(NN)
  148. C
  149. C EPSILON S S
  150. C
  151. B(1,1)=-SP*DD
  152. B(1,2)=-CP*DD
  153. B(1,5)=-B(1,1)
  154. B(1,6)=-B(1,2)
  155. C
  156. C EPSILON THETA THETA
  157. C
  158. B(2,1)= V*(SP2+CP2*Y*(UN+DEUX*X))
  159. B(2,2)= SPCP*U*Y*T(IGAU)
  160. B(2,3)=+AN*V
  161. B(2,4)=-D*CP*X*Y*V
  162. B(2,5)= U*(SP2+CP2*X*(TRS-DEUX*X))
  163. B(2,6)=-B(2,2)
  164. B(2,7)=+AN*U
  165. B(2,8)= D*CP*X*Y*U
  166. C
  167. C EPSILON S THETA
  168. C
  169. B(3,1)=-SP*B(2,3)
  170. B(3,2)=-CP*B(2,3)
  171. B(3,3)=-DD-V*SP
  172. B(3,5)=-SP*B(2,7)
  173. B(3,6)=-CP*B(2,7)
  174. B(3,7)=+DD-U*SP
  175. C
  176. C KSI S S
  177. C
  178. AUX= SIX*T(IGAU)*DD*DD
  179. B(4,1)= CP*AUX
  180. B(4,2)=-SP*AUX
  181. B(4,4)=(QUTR-SIX*X)*DD
  182. B(4,5)=-B(4,1)
  183. B(4,6)=-B(4,2)
  184. B(4,8)=(DEUX-SIX*X)*DD
  185. C
  186. C KSI THETA THETA
  187. C
  188. AUX1=SIX*U*Y*SP*DD
  189. AUX=(UN+DEUX*X)*(AN*V)**2+AUX1
  190. B(5,1)=-CP*AUX
  191. B(5,2)= SP*AUX
  192. B(5,3)=-B(2,3)*CP/RRRR
  193. B(5,4)= D*X*(AN*V)**2-SP*V*(UN-TRS*X)
  194. AUX=(TRS-DEUX*X)*(AN*U)**2-AUX1
  195. B(5,5)=-CP*AUX
  196. B(5,6)= SP*AUX
  197. B(5,7)=-B(2,7)*CP/RRRR
  198. B(5,8)=-D*Y*(AN*U)**2-SP*U*(TRS*X-DEUX)
  199. C
  200. C KSI S THETA
  201. C
  202. AUX1=DOUZ*U*Y*AN*DD
  203. AUX=-AN*SP*(DEUX+QUTR*X)*V*V-AUX1
  204. B(6,1)=-CP*AUX
  205. B(6,2)= SP*AUX
  206. B(6,3)= DEUX*(CP/D+SPCP*V)/RRRR
  207. B(6,4)= AN*V*((DEUX-SIX*X)-DEUX*D*X*V*SP)
  208. AUX=AN*SP*(QUTR*X-SIX)*U*U+AUX1
  209. B(6,5)=-CP*AUX
  210. B(6,6)= SP*AUX
  211. B(6,7)= DEUX*(-CP/D+SPCP*U)/RRRR
  212. B(6,8)= AN*U*((SIX*X-QUTR)+DEUX*D*X*V*SP)
  213. ENDIF
  214. IF(IFOU.EQ.0.OR.(IFOU.EQ.1.AND.NN.EQ.0)) THEN
  215. DJAC=D*UNDE*P(IGAU)*RRRR*2*XPI
  216. ELSEIF(IFOU.EQ.1.AND.NN.NE.0) THEN
  217. DJAC=D*UNDE*P(IGAU)*RRRR*XPI
  218. ELSE
  219. DJAC=D*UNDE*P(IGAU)*RRRR*DIM3
  220. ENDIF
  221. *
  222. * ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  223. *
  224. NSTRS2 = NSTRS / 2
  225. DO 88 IJL=1,NSTRS2
  226. DO 881 IJC=1,LRE
  227. B(IJL,IJC)=B(IJL,IJC)+EXCEN*B(IJL+NSTRS2,IJC)
  228. 881 CONTINUE
  229. 88 CONTINUE
  230. *
  231. 4 CONTINUE
  232. RETURN
  233. END
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  

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