Télécharger pb301.eso

Retour à la liste

Numérotation des lignes :

  1. C PB301 SOURCE MAGN 10/05/18 21:16:31 6675
  2. SUBROUTINE PB301(XREF,X,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2,ITYPI)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C
  7. C CALCULE LES FONCTIONS DE FORME D'UN : SEG3 Element quadratique Q2
  8. C : SEG3 Element macro 2xQ1
  9. C (pression Q1 dans les 2 cas)
  10. C Cf VNIMP pression continue
  11. C ITYPI=0 1 pts d'integration de type Gauss (sous integration)
  12. C ITYPI=1 pts d'integration de type Gauss (en nombre suffisant)
  13. C ITYPI=2 pts d'integration de type Gauss Lobatto i.e. sommets element
  14. C
  15. C REMARQUE :
  16. C En coordonnées cylindriques si le point milieux (2) est
  17. C pile poil au milieu, la matrice masse diagonale s'annule sur l'axe.
  18. C /1
  19. C | 2 pi x N1 dx = 0.
  20. C /0
  21. C Pour remédier à cela on décale un peu le point mileux sur l'élément
  22. C de référence, alfa=0.50000000000005 au lieu de 0.5 .
  23. C Voir aussi pb902.eso et pb702.eso.
  24. C Si on rapprochait les points milieux de l'axe (alfa = 0.45 par exemple)
  25. C la matrice masse diagonale serait négative sur l'axe, ce que l'on ne
  26. C veut pas non plus. En conséquence le choix qu'on a fait doit être
  27. C accompagné d'une orientation correcte de l'élément courant.
  28. C************************************************************************
  29.  
  30. DIMENSION X(NPG),XREF(ND,NP)
  31. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  32. REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  33. DIMENSION U(5),H(5)
  34. CHARACTER*4 NOM2
  35. -INC CCOPTIO
  36.  
  37. XREF(1,1)=0.D0
  38. XREF(1,2)=0.5D0
  39. XREF(1,3)=1.D0
  40.  
  41. IF(IFOMOD.EQ.0)THEN
  42. alfa=0.50000000000005D0
  43. ELSE
  44. alfa=0.5D0
  45. ENDIF
  46.  
  47. h1=1.D0/alfa
  48. h2=-1.D0/alfa/(alfa - 1.D0)
  49. h3=1.D0/(alfa - 1.D0)
  50. CALL CALUHG(U,H,NG)
  51. A=0.D0
  52. B=1.D0
  53. IF(ITYPI.EQ.2)THEN
  54. X(1)=0.D0
  55. X(2)=alfa
  56. X(3)=1.D0
  57. DO 4 L=1,3
  58. PG(L)=1.D0/3.D0
  59. 4 CONTINUE
  60. ELSE
  61. CALL CALG1(A,B,NG,H,U,X,PG)
  62. ENDIF
  63.  
  64. C write(6,*)'Xg=',(X(I),I=1,NPG)
  65. C write(6,*)'Pg=',(Pg(I),I=1,NPG)
  66.  
  67. IF(NOM2.NE.'MCF1')THEN
  68. DO 1 L=1,NPG
  69. FN(1,L)=h1*(X(L)-1.D0)*(X(L)-alfa)
  70. FN(2,L)=h2*X(L)*(1.D0-X(L))
  71. FN(3,L)=h3*X(L)*(alfa-X(L))
  72. GR(1,1,L)=h1*(2.D0*X(L)- 1.D0 - alfa)
  73. GR(1,2,L)=h2*(1.D0-2.D0*X(L))
  74. GR(1,3,L)=h3*(alfa-2.D0*X(L))
  75. 1 CONTINUE
  76. ELSE
  77. C Cas MACRO ELEMENT
  78. DO 10 L=1,NPG
  79. IF(X(L).LE.0.5D0)THEN
  80. FN(1,L)=1.D0-2.D0*X(L)
  81. FN(2,L)=2.D0*X(L)
  82. FN(3,L)=0.D0
  83. GR(1,1,L)=-2.D0
  84. GR(1,2,L)=2.D0
  85. GR(1,3,L)=0.D0
  86. ELSE
  87. FN(1,L)=0.D0
  88. FN(2,L)=2.D0-2.D0*X(L)
  89. FN(3,L)=2.D0*X(L)-1.D0
  90. GR(1,1,L)=0.D0
  91. GR(1,2,L)=-2.D0
  92. GR(1,3,L)=2.D0
  93. ENDIF
  94. 10 CONTINUE
  95. ENDIF
  96.  
  97. IF(MP.EQ.1)THEN
  98. DO 2 L=1,NPG
  99. FM(1,L)=1.D0
  100. GM(1,1,L)=0.D0
  101. 2 CONTINUE
  102. ELSEIF(MP.EQ.2)THEN
  103.  
  104. FM(1,1)= 1.D0
  105. FM(1,2)= 0.D0
  106.  
  107. FM(2,1)= 0.D0
  108. FM(2,2)= 1.D0
  109.  
  110. CALL INITD(GM,(ND*MP*NPG),0.D0)
  111.  
  112. ENDIF
  113. IF(NOM2.EQ.'P1P1'.OR.NOM2.EQ.'PFP1'.OR.NOM2.EQ.'MCF1')THEN
  114. DO 3 L=1,NPG
  115. C
  116. FM(1,L)=1.D0-X(L)
  117. FM(2,L)=X(L)
  118. GM(1,1,L)=-1.D0
  119. GM(1,2,L)=1.D0
  120. 3 CONTINUE
  121.  
  122. ENDIF
  123.  
  124. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  125. C WRITE(6,101)
  126. C DO 104 L=1,NPG
  127. C write(6,*)'FN npg=',L
  128. C WRITE(6,1002)(FN(I,L),I=1,NP)
  129. C write(6,*)'GR(1 npg=',L
  130. C WRITE(6,1002)(GR(1,I,L),I=1,NP)
  131. C write(6,*)'GR(2 npg=',L
  132. C WRITE(6,1002)(GR(2,I,L),I=1,NP)
  133. C write(6,*)'FM npg=',L
  134. C WRITE(6,1002)(FM(I,L),I=1,MP)
  135. C WRITE(6,1002)FM
  136. C WRITE(6,1002)GM
  137. C104 CONTINUE
  138. C WRITE(6,101)
  139. RETURN
  140. 1002 FORMAT(10(1X,1PD11.4))
  141. 1001 FORMAT(20(1X,I5))
  142. 101 FORMAT(1X,'... SUB PB301 ... FN,GR ',9(10H..........)/)
  143. C
  144. END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  

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