Télécharger bgfcq2.eso

Retour à la liste

Numérotation des lignes :

  1. C BGFCQ2 SOURCE AM 10/09/20 21:15:00 6756
  2. SUBROUTINE BGFCQ2(B,NGRA,DJAC,IGAU,IFOU,XEL,NN,T,P,EXCEN,DIM3,
  3. . IARR,XDPGE,YDPGE)
  4. C==================================================================
  5. C CALCUL DE LA MATRICE B DES GRADIENTS DE FLEXION
  6. C DES COQUES @ 2 NOEUDS
  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 EXCEN = EXCENTREMENT
  16. C DIM3 = EPAISSEUR DANS L'AUTRE DIMENSION
  17. C XDPGE,YDPGE : COORDONNEE DU POINT AUTOUR DUQUEL
  18. C FAIT LE MOUVEMENT EN DEFO PLAN GENE
  19. C SORTIE
  20. C B(2,*)=MATRICE B AU POINT DE GAUSS
  21. C DJAC=JACOBIEN AU POINT DE GAUSS=POIGAU*LONG/2 (*R(IGAU), SI
  22. C IFOU EST SUPERIEUR OU EGAL A ZERO)
  23. C IARR=0 SI OK 1 SI LONGUEUR ELEMENT NULLE
  24. C 2 SI R / D INFERIEUR A 10-3
  25. C==================================================================
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. C Include contenant quelques constantes dont XPI, XZERO :
  29. -INC CCREEL
  30. PARAMETER(UNDE=.5D0,UN=1.D0,DEUX=2.D0,TRS=3.D0)
  31. PARAMETER(QUTR=4.D0,SIX=6.D0,DOUZ=12.D0)
  32. DIMENSION B(NGRA,*),T(*),XEL(3,*),P(*)
  33. C
  34. C ---------------------------------INITIALISATION
  35. IARR=0
  36. DJAC=XZERO
  37. IF(IFOU.GT.0) THEN
  38. LRE=8
  39. CALL ZERO(B,2,8)
  40. ELSE IF(IFOU.LE.0) THEN
  41. LRE=6
  42. CALL ZERO(B,2,6)
  43. ENDIF
  44. C
  45. D=SQRT((XEL(1,2)-XEL(1,1))**2+(XEL(2,2)-XEL(2,1))**2)
  46. IF(D.EQ.0) THEN
  47. IARR=1
  48. GOTO 4
  49. ENDIF
  50. DD=UN/D
  51. RO=(XEL(1,1)+XEL(1,2))*UNDE
  52. R1=(XEL(2,1)+XEL(2,2))*UNDE
  53. SP=(XEL(1,2)-XEL(1,1))/D
  54. CP=(XEL(2,2)-XEL(2,1))/D
  55. SP2=SP*SP
  56. CP2=CP*CP
  57. SPCP=SP*CP
  58. C X FONCTION FORME NOEUD 2 RRRR RAYON
  59. C Y FONCTION FORME NOEUD 1 D LONGUEUR DD INVERSE LONGUEUR
  60. X=UNDE+UNDE*T(IGAU)
  61. Y=UNDE-UNDE*T(IGAU)
  62. RRRR=RO+UNDE*D*SP*T(IGAU)
  63. C ---------------------------------
  64. C
  65. C TEST D'ERREUR
  66. C
  67. IF(IFOU.GE.0) THEN
  68. IF(ABS(RRRR/D).LE.1.D-03) THEN
  69. IARR=2
  70. GOTO 4
  71. ENDIF
  72. ENDIF
  73. C
  74. C ---------------------------------CALCULS
  75. C
  76. IF(IFOU.LT.0) RRRR =UN
  77. U=X/RRRR
  78. V=Y/RRRR
  79. C
  80. C AXISYMETRIQUE DEFORMATIONS PLANES CONTRAINTES PLANES
  81. C
  82. IF(IFOU.LE.0) THEN
  83. C
  84. C RT,S
  85. C
  86. AUX = SIX*T(IGAU)*DD*DD
  87. B(1,1)= CP*AUX
  88. B(1,2)=-SP*AUX
  89. B(1,3)=(QUTR-SIX*X)*DD
  90. B(1,4)=-B(1,1)
  91. B(1,5)=-B(1,2)
  92. B(1,6)=(DEUX-SIX*X)*DD
  93. C
  94. C FOURIER
  95. C
  96. ELSE IF(IFOU.GT.0) THEN
  97. AN=DBLE(NN)
  98. C
  99. C RT,S
  100. C
  101. AUX= SIX*T(IGAU)*DD*DD
  102. B(1,1)= CP*AUX
  103. B(1,2)=-SP*AUX
  104. B(1,4)=(QUTR-SIX*X)*DD
  105. B(1,5)=-B(1,1)
  106. B(1,6)=-B(1,2)
  107. B(1,8)=(DEUX-SIX*X)*DD
  108. C
  109. C RT,T
  110. C
  111. AUX1=DOUZ*U*Y*AN*DD
  112. AUX =-AUX1
  113. B(3,1)=-CP*AUX
  114. B(3,2)= SP*AUX
  115. B(3,3)= 0.
  116. B(3,4)= AN*V*(DEUX-SIX*X)
  117. AUX= AUX1
  118. B(3,5)=-CP*AUX
  119. B(3,6)= SP*AUX
  120. B(3,7)= 0.
  121. B(3,8)= AN*U*(SIX*X-QUTR)
  122. ENDIF
  123. IF(IFOU.EQ.0.OR.(IFOU.EQ.1.AND.NN.EQ.0)) THEN
  124. DJAC=D*UNDE*P(IGAU)*RRRR*2*XPI
  125. ELSEIF(IFOU.EQ.1.AND.NN.NE.0) THEN
  126. DJAC=D*UNDE*P(IGAU)*RRRR*XPI
  127. ELSE
  128. DJAC=D*UNDE*P(IGAU)*RRRR*DIM3
  129. ENDIF
  130. *
  131. 4 CONTINUE
  132. RETURN
  133. END
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  

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