Télécharger pb2103.eso

Retour à la liste

Numérotation des lignes :

  1. C PB2103 SOURCE MAGN 10/05/31 21:15:13 6679
  2. SUBROUTINE PB2103
  3. &(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NG,NGT,NPG,NOM2)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C************************************************************************
  7. C
  8. C CALCULE LES FONCTIONS DE FORME D'UN : PR21
  9. C
  10. C ^ eta
  11. C |
  12. C a |n3
  13. C /|\
  14. C / | \ a=sqrt(2)
  15. C / | \
  16. C |\ | \
  17. C | \ |____\ _____>ksi
  18. C | \q a
  19. C | / \
  20. C |/_ _\
  21. C
  22. C zeta
  23. C************************************************************************
  24.  
  25. REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  26. PARAMETER (NPG1=5,NPG2=7)
  27. REAL*8 X1(NPG1),PG1(NPG1)
  28. REAL*8 X2(NPG2),Y2(NPG2),PG2(NPG2)
  29. CHARACTER*4 NOM2
  30. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  31. DIMENSION F2N(7,NPG2),G2R(2,7,NPG2)
  32. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  33. DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3)
  34. DIMENSION I12(21)
  35. * SAVE XA,XB,XC,XD,I12
  36. DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/
  37. DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/
  38. DATA I12/1,2,3,4,5,6,19,7,16,8,17,9,18,21,10,11,12,13,14,15,20/
  39. C***
  40. R2=SQRT(2.D0)
  41.  
  42. XREF(1,1)=0.D0
  43. XREF(2,1)=0.D0
  44. XREF(3,1)=0.D0
  45.  
  46. XREF(1,2)=R2/2.D0
  47. XREF(2,2)=0.D0
  48. XREF(3,2)=0.D0
  49.  
  50. XREF(1,3)=R2
  51. XREF(2,3)=0.D0
  52. XREF(3,3)=0.D0
  53.  
  54. XREF(1,4)=R2/2.D0
  55. XREF(2,4)=R2/2.D0
  56. XREF(3,4)=0.D0
  57.  
  58. XREF(1,5)=0.D0
  59. XREF(2,5)=R2
  60. XREF(3,5)=0.D0
  61.  
  62. XREF(1,6)=0.D0
  63. XREF(2,6)=R2/2.D0
  64. XREF(3,6)=0.D0
  65.  
  66. XREF(1,7)=0.D0
  67. XREF(2,7)=0.D0
  68. XREF(3,7)=0.5D0
  69.  
  70. XREF(1,8)=R2
  71. XREF(2,8)=0.D0
  72. XREF(3,8)=0.5D0
  73.  
  74. XREF(1,9)=0.D0
  75. XREF(2,9)=R2
  76. XREF(3,9)=0.5D0
  77.  
  78. XREF(1,10)=0.D0
  79. XREF(2,10)=0.D0
  80. XREF(3,10)=1.D0
  81.  
  82. XREF(1,11)=R2/2.D0
  83. XREF(2,11)=0.D0
  84. XREF(3,11)=1.D0
  85.  
  86. XREF(1,12)=R2
  87. XREF(2,12)=0.D0
  88. XREF(3,12)=1.D0
  89.  
  90. XREF(1,13)=R2/2.D0
  91. XREF(2,13)=R2/2.D0
  92. XREF(3,13)=1.D0
  93.  
  94. XREF(1,14)=0.D0
  95. XREF(2,14)=R2
  96. XREF(3,14)=1.D0
  97.  
  98. XREF(1,15)=0.D0
  99. XREF(2,15)=R2/2.D0
  100. XREF(3,15)=1.D0
  101.  
  102.  
  103. XREF(1,16)=R2/2.D0
  104. XREF(2,16)=0.D0
  105. XREF(3,16)=0.5D0
  106.  
  107. XREF(1,17)=R2/2.D0
  108. XREF(2,17)=R2/2.D0
  109. XREF(3,17)=0.5D0
  110.  
  111. XREF(1,18)=0.D0
  112. XREF(2,18)=R2/2.D0
  113. XREF(3,18)=0.5D0
  114.  
  115. XREF(1,19)=R2/3.D0
  116. XREF(2,19)=R2/3.D0
  117. XREF(3,19)=0.D0
  118.  
  119. XREF(1,20)=R2/3.D0
  120. XREF(2,20)=R2/3.D0
  121. XREF(3,20)=1.D0
  122.  
  123. XREF(1,21)=R2/3.D0
  124. XREF(2,21)=R2/3.D0
  125. XREF(3,21)=0.5D0
  126.  
  127. IF(NG.GT.5.OR.NGT.GT.7)CALL ARRET(0)
  128.  
  129. CALL CALUHG(U,H,NG)
  130. CALL CALUHH(X2,Y2,PG2,NGT)
  131. A=0.D0
  132. B=1.D0
  133. CALL CALG1(A,B,NG,H,U,X1,PG1)
  134.  
  135. LL=0
  136. DO 1 L=1,NGT
  137. DO 2 L1=1,NG
  138. LL=LL+1
  139. X(L)=X2(L)
  140. Y(L)=Y2(L)
  141. Z(L)=X1(L1)
  142.  
  143. PG(LL)=PG1(L1)*PG2(L)
  144. C write(6,*)' LL x,y,z,pg1,pg2=',
  145. C
  146. XX(1)=X(L)
  147. XX(2)=Y(L)
  148. XX(3)=Z(L)
  149.  
  150. IF(NOM2.EQ.'PRP0')THEN
  151. FM(1,LL)=1.D0
  152. CALL INITD(GM,(3*NPG),0.D0)
  153. ELSEIF(NOM2.EQ.'PRP1')THEN
  154. FM(1,LL)=EQPL3P(XX,XB,XC,XD)/
  155. & EQPL3P(XA,XB,XC,XD)
  156. FM(2,LL)=EQPL3P(XX,XA,XC,XD)/
  157. & EQPL3P(XB,XA,XC,XD)
  158. FM(3,LL)=EQPL3P(XX,XA,XB,XD)/
  159. & EQPL3P(XC,XA,XB,XD)
  160. FM(4,LL)=EQPL3P(XX,XA,XB,XC)/
  161. & EQPL3P(XD,XA,XB,XC)
  162. CALL INITD(GM,(12*NPG),0.D0)
  163. ELSEIF(NOM2.EQ.'PFP1')THEN
  164. FM(1,LL)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  165. FM(2,LL)=-X(L)*(Z(L)-1.D0)/R2
  166. FM(3,LL)=-Y(L)*(Z(L)-1.D0)/R2
  167. FM(4,LL)=-(X(L)+Y(L)-R2)*Z(L)/R2
  168. FM(5,LL)=X(L)*Z(L)/R2
  169. FM(6,LL)=Y(L)*Z(L)/R2
  170. C
  171. GM(1,1,LL)=(Z(L)-1.D0)/R2
  172. GM(2,1,LL)=(Z(L)-1.D0)/R2
  173. GM(3,1,LL)=(X(L)+Y(L)-R2)/R2
  174. GM(1,2,LL)=-(Z(L)-1.D0)/R2
  175. GM(2,2,LL)=0.D0
  176. GM(3,2,LL)=-X(L)/R2
  177. GM(1,3,LL)=0.D0
  178. GM(2,3,LL)=-(Z(L)-1.D0)/R2
  179. GM(3,3,LL)=-Y(L)/R2
  180. GM(1,4,LL)=-Z(L)/R2
  181. GM(2,4,LL)=-Z(L)/R2
  182. GM(3,4,LL)=-(X(L)+Y(L)-R2)/R2
  183. GM(1,5,LL)=Z(L)/R2
  184. GM(2,5,LL)=0.D0
  185. GM(3,5,LL)=X(L)/R2
  186. GM(1,6,LL)=0.D0
  187. GM(2,6,LL)=Z(L)/R2
  188. GM(3,6,LL)=Y(L)/R2
  189. C
  190. ENDIF
  191.  
  192. C
  193. F2N(1,L)=(1.D0-X(L)/R2-Y(L)/R2)*(1.D0-2.D0*X(L)/R2-2.D0*Y(L)/R2+
  194. * 3.D0/2.D0*X(L)*Y(L))
  195. F2N(2,L)=(1.D0-X(L)/R2-Y(L)/R2)*(4.D0/R2-6.D0*Y(L))*X(L)
  196. F2N(3,L)=X(L)/R2*(2.D0*X(L)/R2-1.D0+3.D0*(1.D0-X(L)/R2-Y(L)/R2)
  197. & *Y(L)/R2)
  198. F2N(4,L)=2.D0*X(L)*Y(L)*(1.D0-3.D0*(1.D0-X(L)/R2-Y(L)/R2))
  199. F2N(5,L)=Y(L)*Y(L)-Y(L)*R2/2.D0+3.D0/2.D0*X(L)*Y(L)-
  200. * 3.D0*R2/4.D0*X(L)*X(L)*Y(L)-3.D0*R2/4.D0*X(L)*Y(L)*Y(L)
  201. F2N(6,L)=2.D0*R2*(-R2/2.D0*Y(L)*Y(L)+3.D0/2.D0*(Y(L)*Y(L)*X(L)+
  202. * X(L)*X(L)*Y(L))-2.D0*R2*X(L)*Y(L)+Y(L))
  203. F2N(7,L)=27.D0/2.D0*(X(L)*Y(L)-R2/2.D0*X(L)*X(L)*Y(L)-
  204. *R2/2.D0*X(L)*Y(L)*Y(L))
  205. C
  206. G2R(1,1,L)=-3.D0*R2/4.D0*Y(L)*Y(L)+2.D0*X(L)+7./2.D0*Y(L)-
  207. * 3.D0*R2/2.D0*X(L)*Y(L)-3.D0*R2/2.D0
  208. G2R(2,1,L)=-3.D0*R2/4.D0*X(L)*X(L)+2.D0*Y(L)+7./2.D0*X(L)-
  209. * 3.D0*R2/2.D0*X(L)*Y(L)-3.D0*R2/2.D0
  210. G2R(1,2,L)=3.D0*R2*Y(L)*Y(L)+6.D0*R2*X(L)*Y(L)-4.D0*X(L)
  211. & -8.D0*Y(L)+2.D0*R2
  212. G2R(2,2,L)=3.D0*R2*X(L)*X(L)+6.D0*R2*X(L)*Y(L)-8.D0*X(L)
  213. G2R(1,3,L)=-3.D0*R2/4.D0*Y(L)*Y(L)-3.D0*R2/2.D0*X(L)*Y(L)+
  214. * 2.D0*X(L)+3.D0/2.D0*Y(L)-R2/2.D0
  215. G2R(2,3,L)=R2/2.D0*(-3.D0/2.D0*X(L)*X(L)-3.D0*X(L)*Y(L)+
  216. * 3.D0*R2/2.D0*X(L))
  217. G2R(1,4,L)=3.D0*R2*Y(L)*Y(L)+6.D0*R2*X(L)*Y(L)-4.D0*Y(L)
  218. G2R(2,4,L)=3.D0*R2*X(L)*X(L)+6.D0*R2*X(L)*Y(L)-4.D0*X(L)
  219. G2R(1,5,L)=-3.D0*R2/4.D0*Y(L)*Y(L)-3.D0*R2/2.D0*X(L)*Y(L)
  220. & +3.D0/2.D0*Y(L)
  221. G2R(2,5,L)=-3.D0*R2/4.D0*X(L)*X(L)-3.D0*R2/2.D0*X(L)*Y(L)
  222. & +2.D0*Y(L)+
  223. * 3.D0/2.D0*X(L)-R2/2.D0
  224. G2R(1,6,L)=3.D0*R2*Y(L)*Y(L)+6.D0*R2*X(L)*Y(L)-8.D0*Y(L)
  225. G2R(2,6,L)=3.D0*R2*X(L)*X(L)+6.D0*R2*X(L)*Y(L)-8.D0*X(L)
  226. & -4.D0*Y(L)+2.D0*R2
  227. G2R(1,7,L)=27.D0/2.D0*(-R2/2*Y(L)*Y(L)-R2*X(L)*Y(L)+Y(L))
  228. G2R(2,7,L)=27.D0/2.D0*(-R2/2*X(L)*X(L)-R2*X(L)*Y(L)+X(L))
  229. C
  230. DO 111 I=1,7
  231. I1=I12(I)
  232. I7=I12(I+7)
  233. I14=I12(I+14)
  234. FN(I1,LL)=F2N(I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)
  235. FN(I7,LL)=F2N(I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)
  236. FN(I14,LL)=F2N(I,L)*Z(L)*(2.D0*Z(L)-1.D0)
  237.  
  238. GR(1,I1,LL)=G2R(1,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)
  239. GR(2,I1,LL)=G2R(2,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)
  240. GR(3,I1,LL)=F2N(I,L)*(4.D0*Z(L)-3.D0)
  241.  
  242. GR(1,I7,LL)=G2R(1,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)
  243. GR(2,I7,LL)=G2R(2,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)
  244. GR(3,I7,LL)=F2N(I,L)*(-8.D0*Z(L)+4.D0)
  245.  
  246. GR(1,I14,LL)=G2R(1,I,L)*Z(L)*(2.D0*Z(L)-1.D0)
  247. GR(2,I14,LL)=G2R(2,I,L)*Z(L)*(2.D0*Z(L)-1.D0)
  248. GR(3,I14,LL)=F2N(I,L)*(4.D0*Z(L)-1.D0)
  249.  
  250. 111 CONTINUE
  251.  
  252. 2 CONTINUE
  253. 1 CONTINUE
  254. C
  255. C
  256. C WRITE(6,101)
  257. C WRITE(6,1002)FM
  258. C WRITE(6,1002)GM
  259. C write(6,*)' FN'
  260. C WRITE(6,1002)FN
  261. C write(6,*)' GR'
  262. C WRITE(6,1002)GR
  263. C WRITE(6,101)
  264.  
  265. RETURN
  266. 1002 FORMAT(10(1X,1PD11.4))
  267. 1001 FORMAT(20(1X,I5))
  268. 101 FORMAT(1X,'... SUBPB2103 ... FM,GM,FN,GR ',9(10H..........)/)
  269. C
  270. END
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  

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