Télécharger pb301.eso

Retour à la liste

Numérotation des lignes :

pb301
  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.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38.  
  39. XREF(1,1)=0.D0
  40. XREF(1,2)=0.5D0
  41. XREF(1,3)=1.D0
  42.  
  43. IF(IFOMOD.EQ.0)THEN
  44. alfa=0.50000000000005D0
  45. ELSE
  46. alfa=0.5D0
  47. ENDIF
  48.  
  49. h1=1.D0/alfa
  50. h2=-1.D0/alfa/(alfa - 1.D0)
  51. h3=1.D0/(alfa - 1.D0)
  52. CALL CALUHG(U,H,NG)
  53. A=0.D0
  54. B=1.D0
  55. IF(ITYPI.EQ.2)THEN
  56. X(1)=0.D0
  57. X(2)=alfa
  58. X(3)=1.D0
  59. DO 4 L=1,3
  60. PG(L)=1.D0/3.D0
  61. 4 CONTINUE
  62. ELSE
  63. CALL CALG1(A,B,NG,H,U,X,PG)
  64. ENDIF
  65.  
  66. C write(6,*)'Xg=',(X(I),I=1,NPG)
  67. C write(6,*)'Pg=',(Pg(I),I=1,NPG)
  68.  
  69. IF(NOM2.NE.'MCF1')THEN
  70. DO 1 L=1,NPG
  71. FN(1,L)=h1*(X(L)-1.D0)*(X(L)-alfa)
  72. FN(2,L)=h2*X(L)*(1.D0-X(L))
  73. FN(3,L)=h3*X(L)*(alfa-X(L))
  74. GR(1,1,L)=h1*(2.D0*X(L)- 1.D0 - alfa)
  75. GR(1,2,L)=h2*(1.D0-2.D0*X(L))
  76. GR(1,3,L)=h3*(alfa-2.D0*X(L))
  77. 1 CONTINUE
  78. ELSE
  79. C Cas MACRO ELEMENT
  80. DO 10 L=1,NPG
  81. IF(X(L).LE.0.5D0)THEN
  82. FN(1,L)=1.D0-2.D0*X(L)
  83. FN(2,L)=2.D0*X(L)
  84. FN(3,L)=0.D0
  85. GR(1,1,L)=-2.D0
  86. GR(1,2,L)=2.D0
  87. GR(1,3,L)=0.D0
  88. ELSE
  89. FN(1,L)=0.D0
  90. FN(2,L)=2.D0-2.D0*X(L)
  91. FN(3,L)=2.D0*X(L)-1.D0
  92. GR(1,1,L)=0.D0
  93. GR(1,2,L)=-2.D0
  94. GR(1,3,L)=2.D0
  95. ENDIF
  96. 10 CONTINUE
  97. ENDIF
  98.  
  99. IF(MP.EQ.1)THEN
  100. DO 2 L=1,NPG
  101. FM(1,L)=1.D0
  102. GM(1,1,L)=0.D0
  103. 2 CONTINUE
  104. ELSEIF(MP.EQ.2)THEN
  105.  
  106. FM(1,1)= 1.D0
  107. FM(1,2)= 0.D0
  108.  
  109. FM(2,1)= 0.D0
  110. FM(2,2)= 1.D0
  111.  
  112. CALL INITD(GM,(ND*MP*NPG),0.D0)
  113.  
  114. ENDIF
  115. IF(NOM2.EQ.'P1P1'.OR.NOM2.EQ.'PFP1'.OR.NOM2.EQ.'MCF1')THEN
  116. DO 3 L=1,NPG
  117. C
  118. FM(1,L)=1.D0-X(L)
  119. FM(2,L)=X(L)
  120. GM(1,1,L)=-1.D0
  121. GM(1,2,L)=1.D0
  122. 3 CONTINUE
  123.  
  124. ENDIF
  125.  
  126. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  127. C WRITE(6,101)
  128. C DO 104 L=1,NPG
  129. C write(6,*)'FN npg=',L
  130. C WRITE(6,1002)(FN(I,L),I=1,NP)
  131. C write(6,*)'GR(1 npg=',L
  132. C WRITE(6,1002)(GR(1,I,L),I=1,NP)
  133. C write(6,*)'GR(2 npg=',L
  134. C WRITE(6,1002)(GR(2,I,L),I=1,NP)
  135. C write(6,*)'FM npg=',L
  136. C WRITE(6,1002)(FM(I,L),I=1,MP)
  137. C WRITE(6,1002)FM
  138. C WRITE(6,1002)GM
  139. C104 CONTINUE
  140. C WRITE(6,101)
  141. RETURN
  142. 1002 FORMAT(10(1X,1PD11.4))
  143. 1001 FORMAT(20(1X,I5))
  144. 101 FORMAT(1X,'... SUB PB301 ... FN,GR ',9(10H..........)/)
  145. C
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  

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