Télécharger bgrcq2.eso

Retour à la liste

Numérotation des lignes :

  1. C BGRCQ2 SOURCE PV 11/04/07 21:15:00 6935
  2. SUBROUTINE BGRCQ2(BGR,DJAC,IGAU,IFOU,XEL,NN,T,P,IARR)
  3. C|=================================================================|
  4. C| CALCUL DE LA MATRICE BGR DES COQUES @ 2 NOEUDS |
  5. C| ROUTINE FORTRAN PUR |
  6. C| SUO X.Z. JANVIER 87 |
  7. C| |
  8. C|= ENTREES |
  9. C| IGAU=NUMERO DU POINT DE GAUSS |
  10. C| IFOU=IFOUR DE CCOPTIO |
  11. C| XEL=COORDONNEES LOCALE DE L'ELEMENT |
  12. C| NN=NUMERO DU MODE DE FOURIER |
  13. C| T(IGAU)=POSITION DU POINT DE GAUSS |
  14. C| P(IGAU)=POIDS DU POINT DE GAUSS |
  15. C|= SORTIE |
  16. C| BGR(9,8)=MATRICE BGR AU POINT DE GAUSSPOUR IFOU GT 0 |
  17. C| BGR(9,6)=MATRICE BGR AU POINT DE GAUSSPOUR IFOU LE 0 |
  18. C| DJAC=JACOBIEN AU POINT DE GAUSS=POIGAU*LONG/2 (*R(IGAU), SI |
  19. C| IFOU EST SUPERIEUR OU EGAL A ZERO) |
  20. C| IARR=0 SI OK 1 SI LONGUEUR ELEMENT NULLE |
  21. C| 2 SI R / D INFERIEUR A 10-3 |
  22. C| |
  23. C| CODE SUO X.Z. |
  24. C|=================================================================|
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. PARAMETER(XZER=0.D0,UNDE=.5D0,UN=1.D0,DEUX=2.D0,TRS=3.D0)
  28. PARAMETER(QUTR=4.D0,SIX=6.D0,DOUZ=12.D0)
  29. DIMENSION BGR(9,*),T(*),XEL(3,*),P(*)
  30. C
  31. C ---------------------------------INITIALISATION
  32. IARR=0
  33. DJAC=XZER
  34. IF(IFOU.GT.0) THEN
  35. CALL ZERO(BGR,9,8)
  36. ELSE IF(IFOU.LE.0) THEN
  37. CALL ZERO(BGR,9,6)
  38. ENDIF
  39. C
  40. D=SQRT((XEL(1,2)-XEL(1,1))**2+(XEL(2,2)-XEL(2,1))**2)
  41. IF(D.EQ.0) THEN
  42. IARR=1
  43. GOTO 4
  44. ENDIF
  45. DD=UN/D
  46. RO=(XEL(1,1)+XEL(1,2))*UNDE
  47. SP=(XEL(1,2)-XEL(1,1))/D
  48. CP=(XEL(2,2)-XEL(2,1))/D
  49. SP2=SP*SP
  50. CP2=CP*CP
  51. SPCP=SP*CP
  52. C X FONCTION FORME NOEUD 2 RRRR RAYON
  53. C Y FONCTION FORME NOEUD 1 D LONGUEUR DD INVERSE LONGUEUR
  54. X=UNDE+UNDE*T(IGAU)
  55. Y=UNDE-UNDE*T(IGAU)
  56. RRRR=RO+UNDE*D*SP*T(IGAU)
  57. C ---------------------------------
  58. C
  59. C TEST D'ERREUR
  60. C
  61. IF(ABS(RRRR/D).LE.1.D-03.AND.IFOU.GE.0) THEN
  62. IARR=2
  63. GOTO 4
  64. ENDIF
  65. C
  66. C ======= CALCULS ======
  67. C
  68. IF(IFOU.LT.0) THEN
  69. RRRR=1.0D0
  70. ENDIF
  71. U=X/RRRR
  72. V=Y/RRRR
  73. C
  74. C AXISYMMETRIQUE DEORMATIONS PLANES CONTRAINTES PLANES
  75. C
  76. IF(IFOU.LE.0) THEN
  77. C
  78. C GRADIAN DUDS
  79. C
  80. BGR(1,1)=-SP*DD
  81. BGR(1,2)=-CP*DD
  82. BGR(1,4)=-BGR(1,1)
  83. BGR(1,5)=-BGR(1,2)
  84. C
  85. C GRADIAN DUDZ
  86. C
  87. AUX = SIX*X*Y*DD
  88. BGR(3,1)=-CP*AUX
  89. BGR(3,2)= SP*AUX
  90. BGR(3,3)=-(UN-TRS*X)*Y
  91. BGR(3,4)= CP*AUX
  92. BGR(3,5)=-SP*AUX
  93. BGR(3,6)=-(TRS*X-DEUX)*X
  94. C
  95. C GRADIAN DVD0
  96. C
  97. BGR(5,1)= V*(SP2+CP2*Y*(UN+DEUX*X))
  98. BGR(5,2)= SPCP*U*Y*T(IGAU)
  99. BGR(5,3)=-D*CP*X*Y*V
  100. BGR(5,4)= U*(SP2+CP2*X*(TRS-DEUX*X))
  101. BGR(5,5)=-SPCP*U*Y*T(IGAU)
  102. BGR(5,6)= D*CP*X*Y*U
  103. C
  104. C GRADIAN DWDS
  105. C
  106. DO 999 I=1,6
  107. BGR(7,I) = -BGR(3,I)
  108. 999 CONTINUE
  109. C ENDIF
  110. C
  111. C ===== CALCUL EN SERIS DE FOURIER =====
  112. C
  113. ELSE IF(IFOU.GT.0) THEN
  114. AN=DBLE(NN)
  115. C
  116. C GRADIAN DUDS
  117. C
  118. BGR(1,1)=-SP*DD
  119. BGR(1,2)=-CP*DD
  120. BGR(1,5)=-BGR(1,1)
  121. BGR(1,6)=-BGR(1,2)
  122. C
  123. C GRADIAN DVD0
  124. C
  125. BGR(5,1)= V*(SP2+CP2*Y*(UN+DEUX*X))
  126. BGR(5,2)= SPCP*U*Y*T(IGAU)
  127. BGR(5,3)=-AN*V
  128. BGR(5,4)=-D*CP*X*Y*V
  129. BGR(5,5)= U*(SP2+CP2*X*(TRS-DEUX*X))
  130. BGR(5,6)=-SPCP*Y*U*T(IGAU)
  131. BGR(5,7)=-AN*U
  132. BGR(5,8)= D*CP*X*Y*U
  133. C
  134. C GRADIAN DUD0
  135. C
  136. BGR(2,1)= -SP*V*AN
  137. BGR(2,2)= -CP*V*AN
  138. BGR(2,3)= V*SP
  139. BGR(2,5)= -SP*U*AN
  140. BGR(2,6)= -CP*U*AN
  141. BGR(2,7)= U*SP
  142. C
  143. C GRADIAN DVDS
  144. C
  145. BGR(4,3)=DD
  146. BGR(4,7)=-DD
  147. C
  148. C GRADIAN DUDZ
  149. C
  150. AUX=SIX*Y*X*DD
  151. BGR(3,1)=-CP*AUX
  152. BGR(3,2)= SP*AUX
  153. BGR(3,4)=-(UN-TRS*X)*Y
  154. BGR(3,5)= CP*AUX
  155. BGR(3,6)=-SP*AUX
  156. BGR(3,8)=-(TRS*X-DEUX)*X
  157. C
  158. C GRADIAN DVDZ
  159. C
  160. AUX1=AN*Y*V*(UN+DEUX*X)
  161. AUX2=AN*X*U*(TRS-DEUX*X)
  162. BGR(6,1)=-CP*AUX1
  163. BGR(6,2)= SP*AUX1
  164. BGR(6,3)= V*CP
  165. BGR(6,4)= AN*D*X*Y*V
  166. BGR(6,5)=-CP*AUX2
  167. BGR(6,6)= SP*AUX2
  168. BGR(6,7)= U*CP
  169. BGR(6,8)=-AN*D*Y*X*U
  170. C
  171. C GRADIAN DWDS
  172. C
  173. DO 10 I=1,8
  174. BGR(7,I)= -BGR(3,I)
  175. 10 CONTINUE
  176. C
  177. C GRADIAN DWD0
  178. C
  179. DO 20 I=1,8
  180. BGR(8,I)= -BGR(6,I)
  181. BGR(9,I)=XZER
  182. 20 CONTINUE
  183. DJAC=D*UNDE*P(IGAU)*RRRR
  184. ENDIF
  185. 4 CONTINUE
  186. RETURN
  187. END
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  

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