Télécharger pb503.eso

Retour à la liste

Numérotation des lignes :

  1. C PB503 SOURCE MAGN 10/05/19 21:15:11 6676
  2. SUBROUTINE PB503(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*********************************************************************
  6. C PYRAMIDE
  7. C CALCUL DES FONCTIONS DE FORME ET DIVERS POINTS D'INTEGRATION
  8. C VALEURS F(P)
  9. C Z Y XREF
  10. C | / P1 | 1. 0. 0.
  11. C 1. 1. |
  12. C | / P2 | 0. 1. 0.
  13. C | / |
  14. C | / P3 |-1. 0. 0.
  15. C |/ |
  16. C ----------(-1.)--------|-------------1.-------->X P4 | 0. -1. 0.
  17. C / |
  18. C / P5 | 0. 0. 1.
  19. C /
  20. C /
  21. C -1.
  22. C*********************************************************************
  23. CHARACTER*4 NOM2
  24. REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  25. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  26. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  27. REAL*8 A,B,C,D,U(5),H(5)
  28. REAL*8 CO,AL,BE,DIV
  29.  
  30. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  31. XZERO=0.0D0
  32.  
  33. XREF(1,1)=1.D0
  34. XREF(2,1)=0.D0
  35. XREF(3,1)=0.D0
  36.  
  37. XREF(1,2)=0.D0
  38. XREF(2,2)=1.D0
  39. XREF(3,2)=0.D0
  40.  
  41. XREF(1,3)=-1.D0
  42. XREF(2,3)=0.D0
  43. XREF(3,3)=0.D0
  44.  
  45. XREF(1,4)=0.D0
  46. XREF(2,4)=-1.D0
  47. XREF(3,4)=0.D0
  48.  
  49. XREF(1,5)=0.D0
  50. XREF(2,5)=0.D0
  51. XREF(3,5)=1.D0
  52.  
  53. C Verification des coordonnées
  54. IF(.FALSE.)THEN
  55. C IF(.TRUE.)THEN
  56. DO 11 L=1,NP
  57. X(L)=XREF(1,L)
  58. Y(L)=XREF(2,L)
  59. Z(L)=XREF(3,L)
  60. 11 CONTINUE
  61.  
  62. DO 12 L=1,NP
  63. DZEM = 1.D0 - Z(L) + 1.D-10
  64. DZEM4= (1.0D0 - Z(L))*4.0D0 + 1.D-10
  65. AUX = X(L)+Y(L)+Z(L)-1.0D0
  66. AUX1 =-X(L)+Y(L)+Z(L)-1.0D0
  67. AUX2 =-X(L)-Y(L)+Z(L)-1.0D0
  68. AUX3 = X(L)-Y(L)+Z(L)-1.0D0
  69. C
  70. FN(1,L)=AUX1*AUX2/DZEM4
  71. FN(2,L)=AUX2*AUX3/DZEM4
  72. FN(3,L)=AUX*AUX3/DZEM4
  73. FN(4,L)=AUX*AUX1/DZEM4
  74. FN(5,L)=Z(L)
  75. write(6,1033)L,FN(1,L),FN(2,L),FN(3,L),FN(4,L),FN(5,L)
  76. 12 CONTINUE
  77. 1033 FORMAT(1X,I4,' FN',10(1X,1PD11.4))
  78. ENDIF
  79. C Fin Vérification
  80.  
  81. IF(NPG.EQ.1)THEN
  82. X(1)=0.D0
  83. Y(1)=0.D0
  84. Z(1)=0.25D0
  85. PG(1)=2.D0/3.D0
  86. ENDIF
  87. IF(NPG.EQ.5)THEN
  88. AUX=0.5D0
  89. H1 = 0.1531754163448146D0
  90. H2 = 0.6372983346207416D0
  91. PO=2.D0 / 15.D0
  92. C
  93. X(1)=AUX
  94. Y(1)=XZERO
  95. Z(1)=H1
  96. PG(1)=PO
  97. C
  98. X(2)=XZERO
  99. Y(2)=-AUX
  100. Z(2)=H1
  101. PG(2)=PO
  102. C
  103. X(3)=AUX
  104. Y(3)=XZERO
  105. Z(3)=H1
  106. PG(3)=PO
  107. C
  108. X(4)=XZERO
  109. Y(4)=-AUX
  110. Z(4)=H1
  111. PG(4)=PO
  112. C
  113. X(5)=XZERO
  114. Y(5)=XZERO
  115. Z(5)=H2
  116. PG(5)=PO
  117. C
  118. ENDIF
  119. DO 1 L=1,NPG
  120. DZEM = 1.D0 - Z(L)
  121. DZEM4= (1.0D0 - Z(L))*4.0D0
  122. AUX = X(L)+Y(L)+Z(L)-1.0D0
  123. AUX1 =-X(L)+Y(L)+Z(L)-1.0D0
  124. AUX2 =-X(L)-Y(L)+Z(L)-1.0D0
  125. AUX3 = X(L)-Y(L)+Z(L)-1.0D0
  126. C
  127. FN(1,L)=AUX1*AUX2/DZEM4
  128. FN(2,L)=AUX2*AUX3/DZEM4
  129. FN(3,L)=AUX*AUX3/DZEM4
  130. FN(4,L)=AUX*AUX1/DZEM4
  131. FN(5,L)=Z(L)
  132. C
  133. GR(1,1,L)=(-AUX1-AUX2)/DZEM4
  134. GR(2,1,L)=( AUX2-AUX1)/DZEM4
  135. GR(3,1,L)=(AUX1+AUX2+AUX1*AUX2/DZEM)/DZEM4
  136. C
  137. GR(1,2,L)=( AUX2-AUX3)/DZEM4
  138. GR(2,2,L)=(-AUX2-AUX3)/DZEM4
  139. GR(3,2,L=(AUX2+AUX3+AUX2*AUX3/DZEM)/DZEM4
  140. C
  141. GR(1,3,L)=( AUX +AUX3)/DZEM4
  142. GR(2,3,L)=( AUX3-AUX )/DZEM4
  143. GR(3,3,L)=(AUX3+AUX +AUX3*AUX /DZEM)/DZEM4
  144. C
  145. GR(1,4,L)=( AUX1-AUX )/DZEM4
  146. GR(2,4,L)=( AUX +AUX1)/DZEM4
  147. GR(3,4,L)=( AUX+AUX1+ AUX*AUX1/DZEM)/DZEM4
  148. C
  149. GR(1,5,L)=XZERO
  150. GR(2,5,L)=XZERO
  151. GR(3,5,L)=1.0D0
  152. C
  153.  
  154. IF(NOM2.EQ.'P1P1')THEN
  155. FM(1,L)=FN(1,L)
  156. FM(2,L)=FN(2,L)
  157. FM(3,L)=FN(3,L)
  158. FM(4,L)=FN(4,L)
  159. FM(5,L)=FN(5,L)
  160. C
  161. GM(1,1,L)=(-AUX1-AUX2)/DZEM4
  162. GM(2,1,L)=( AUX2-AUX1)/DZEM4
  163. GM(3,1,L)=(AUX1+AUX2+AUX1*AUX2/DZEM)/DZEM4
  164. C
  165. GM(1,2,L)=( AUX2-AUX3)/DZEM4
  166. GM(2,2,L)=(-AUX2-AUX3)/DZEM4
  167. GM(3,2,L)=(AUX2+AUX3+AUX2*AUX3/DZEM)/DZEM4
  168. C
  169. GM(1,3,L)=( AUX +AUX3)/DZEM4
  170. GM(2,3,L)=( AUX3-AUX )/DZEM4
  171. GM(3,3,L)=(AUX3+AUX +AUX3*AUX /DZEM)/DZEM4
  172. C
  173. GM(1,4,L)=( AUX1-AUX )/DZEM4
  174. GM(2,4,L)=( AUX +AUX1)/DZEM4
  175. GM(3,4,L)=( AUX+AUX1+ AUX*AUX1/DZEM)/DZEM4
  176. C
  177. GM(1,5,L)=XZERO
  178. GM(2,5,L)=XZERO
  179. GM(3,5,L)=1.0D0
  180. C
  181. ELSE
  182. FM(1,L)=1.D0
  183. GM(1,1,L)=0.D0
  184. GM(2,1,L)=0.D0
  185. GM(3,1,L)=0.D0
  186. ENDIF
  187. 1 CONTINUE
  188.  
  189. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  190. C WRITE(6,100)
  191. C WRITE(6,101)
  192. C WRITE(6,1002)FN
  193. C WRITE(6,1002)GR
  194. C WRITE(6,101)
  195. RETURN
  196. 1003 FORMAT(1X,' FN',10(1X,1PD11.4))
  197. 1002 FORMAT(1X,' GR',3(1X,1PD11.4))
  198. 1001 FORMAT(20(1X,I5))
  199. 100 FORMAT(1H1)
  200. 101 FORMAT(1X,'... SUB PB503 ... FN,GR,FOM,GM ',9(10H..........)/)
  201. END
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  

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