Télécharger pb803.eso

Retour à la liste

Numérotation des lignes :

  1. C PB803 SOURCE MAGN 10/05/19 21:15:13 6676
  2. SUBROUTINE PB803(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2)
  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 : CUB8
  8. C
  9. C ^ zeta
  10. C | n8______n7
  11. C | / /|
  12. C 1 |/_______/ |
  13. C |n5| |n6|
  14. C | |eta_|__|
  15. C | /n4 | /n3
  16. C |/______|/____>ksi
  17. C 0 1
  18. C n1 n2
  19. C
  20. C************************************************************************
  21.  
  22. REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  23. CHARACTER*4 NOM2
  24. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  25. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  26. DIMENSION U(5),H(5)
  27. C***
  28. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  29. NGG=NG*NG*NG
  30. IF(NP.NE.8.OR.ND.NE.3.OR.NGG.NE.NPG)
  31. *WRITE(6,1001)NP,ND,NG,NPG,NGG
  32. IF(NP.NE.8.OR.ND.NE.3.OR.NGG.NE.NPG)CALL ARRET(0)
  33. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  34.  
  35. XREF(1,1)=0.D0
  36. XREF(2,1)=0.D0
  37. XREF(3,1)=0.D0
  38.  
  39. XREF(1,2)=1.D0
  40. XREF(2,2)=0.D0
  41. XREF(3,2)=0.D0
  42.  
  43. XREF(1,3)=1.D0
  44. XREF(2,3)=1.D0
  45. XREF(3,3)=0.D0
  46.  
  47. XREF(1,4)=0.D0
  48. XREF(2,4)=1.D0
  49. XREF(3,4)=0.D0
  50.  
  51. XREF(1,5)=0.D0
  52. XREF(2,5)=0.D0
  53. XREF(3,5)=1.D0
  54.  
  55. XREF(1,6)=1.D0
  56. XREF(2,6)=0.D0
  57. XREF(3,6)=1.D0
  58.  
  59. XREF(1,7)=1.D0
  60. XREF(2,7)=1.D0
  61. XREF(3,7)=1.D0
  62.  
  63. XREF(1,8)=0.D0
  64. XREF(2,8)=1.D0
  65. XREF(3,8)=1.D0
  66.  
  67. CALL CALUHG(U,H,NG)
  68. A=0.D0
  69. B=1.D0
  70. C=0.D0
  71. D=1.D0
  72. E=0.D0
  73. F=1.D0
  74. CALL CALG3(A,B,C,D,E,F,NG,H,U,X,Y,Z,PG)
  75. DO 1 L=1,NPG
  76. C
  77. FN(1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)*(Z(L)-1.D0)
  78. FN(2,L)=X(L)*(Y(L)-1.D0)*(Z(L)-1.D0)
  79. FN(3,L)=-X(L)*Y(L)*(Z(L)-1.D0)
  80. FN(4,L)=(X(L)-1.D0)*Y(L)*(Z(L)-1.D0)
  81. FN(5,L)=(X(L)-1.D0)*(Y(L)-1.D0)*Z(L)
  82. FN(6,L)=-X(L)*(Y(L)-1.D0)*Z(L)
  83. FN(7,L)=X(L)*Y(L)*Z(L)
  84. FN(8,L)=-(X(L)-1.D0)*Y(L)*Z(L)
  85. C
  86. GR(1,1,L)=-(Y(L)-1.D0)*(Z(L)-1.D0)
  87. GR(2,1,L)=-(X(L)-1.D0)*(Z(L)-1.D0)
  88. GR(3,1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)
  89. C
  90. GR(1,2,L)=(Y(L)-1.D0)*(Z(L)-1.D0)
  91. GR(2,2,L)=X(L)*(Z(L)-1.D0)
  92. GR(3,2,L)=X(L)*(Y(L)-1.D0)
  93. C
  94. GR(1,3,L)=-Y(L)*(Z(L)-1.D0)
  95. GR(2,3,L)=-X(L)*(Z(L)-1.D0)
  96. GR(3,3,L)=-X(L)*Y(L)
  97. C
  98. GR(1,4,L)=Y(L)*(Z(L)-1.D0)
  99. GR(2,4,L)=(X(L)-1.D0)*(Z(L)-1.D0)
  100. GR(3,4,L)=(X(L)-1.D0)*Y(L)
  101. C
  102. GR(1,5,L)=(Y(L)-1.D0)*Z(L)
  103. GR(2,5,L)=(X(L)-1.D0)*Z(L)
  104. GR(3,5,L)=(X(L)-1.D0)*(Y(L)-1.D0)
  105. C
  106. GR(1,6,L)=-(Y(L)-1.D0)*Z(L)
  107. GR(2,6,L)=-X(L)*Z(L)
  108. GR(3,6,L)=-X(L)*(Y(L)-1.D0)
  109. C
  110. GR(1,7,L)=Y(L)*Z(L)
  111. GR(2,7,L)=X(L)*Z(L)
  112. GR(3,7,L)=X(L)*Y(L)
  113. C
  114. GR(1,8,L)=-Y(L)*Z(L)
  115. GR(2,8,L)=-(X(L)-1.D0)*Z(L)
  116. GR(3,8,L)=-(X(L)-1.D0)*Y(L)
  117. C
  118. C
  119.  
  120. IF(NOM2.EQ.'P1P1')THEN
  121. FM(1,L)=FN(1,L)
  122. FM(2,L)=FN(2,L)
  123. FM(3,L)=FN(3,L)
  124. FM(4,L)=FN(4,L)
  125. FM(5,L)=FN(5,L)
  126. FM(6,L)=FN(6,L)
  127. FM(7,L)=FN(7,L)
  128. FM(8,L)=FN(8,L)
  129. C
  130. GM(1,1,L)=-(Y(L)-1.D0)*(Z(L)-1.D0)
  131. GM(2,1,L)=-(X(L)-1.D0)*(Z(L)-1.D0)
  132. GM(3,1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)
  133. C
  134. GM(1,2,L)=(Y(L)-1.D0)*(Z(L)-1.D0)
  135. GM(2,2,L)=X(L)*(Z(L)-1.D0)
  136. GM(3,2,L)=X(L)*(Y(L)-1.D0)
  137. C
  138. GM(1,3,L)=-Y(L)*(Z(L)-1.D0)
  139. GM(2,3,L)=-X(L)*(Z(L)-1.D0)
  140. GM(3,3,L)=-X(L)*Y(L)
  141. C
  142. GM(1,4,L)=Y(L)*(Z(L)-1.D0)
  143. GM(2,4,L)=(X(L)-1.D0)*(Z(L)-1.D0)
  144. GM(3,4,L)=(X(L)-1.D0)*Y(L)
  145. C
  146. GM(1,5,L)=(Y(L)-1.D0)*Z(L)
  147. GM(2,5,L)=(X(L)-1.D0)*Z(L)
  148. GM(3,5,L)=(X(L)-1.D0)*(Y(L)-1.D0)
  149. C
  150. GM(1,6,L)=-(Y(L)-1.D0)*Z(L)
  151. GM(2,6,L)=-X(L)*Z(L)
  152. GM(3,6,L)=-X(L)*(Y(L)-1.D0)
  153. C
  154. GM(1,7,L)=Y(L)*Z(L)
  155. GM(2,7,L)=X(L)*Z(L)
  156. GM(3,7,L)=X(L)*Y(L)
  157. C
  158. GM(1,8,L)=-Y(L)*Z(L)
  159. GM(2,8,L)=-(X(L)-1.D0)*Z(L)
  160. GM(3,8,L)=-(X(L)-1.D0)*Y(L)
  161. C
  162. ELSE
  163. FM(1,L)=1.D0
  164. GM(1,1,L)=0.D0
  165. GM(2,1,L)=0.D0
  166. GM(3,1,L)=0.D0
  167. ENDIF
  168.  
  169. 1 CONTINUE
  170.  
  171. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  172. C WRITE(6,100)
  173. C WRITE(6,101)
  174. C WRITE(6,1002)FN
  175. C WRITE(6,1002)GR
  176. C WRITE(6,101)
  177. RETURN
  178. 1002 FORMAT(10(1X,1PD11.4))
  179. 1001 FORMAT(20(1X,I5))
  180. 100 FORMAT(1H1)
  181. 101 FORMAT(1X,'... SUB PB803 ... FN,GR,FOM,GM ',9(10H..........)/)
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  

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