Télécharger pb2703.eso

Retour à la liste

Numérotation des lignes :

  1. C PB2703 SOURCE MAGN 10/05/31 21:15:15 6679
  2. SUBROUTINE PB2703(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 : CU27
  8. C % eta
  9. C /
  10. C ^ zeta
  11. C | 19_______18______17
  12. C | / . / |
  13. C | / . / |
  14. C | 20.......26..... 16 |
  15. C | / .. / |
  16. C | / . . / |
  17. C 1. 13______14______15 |
  18. C | | . | |
  19. C | .12.....23.|......11
  20. C | . | D . . | .|
  21. C | . | .. B | . |
  22. C | 24 ......27...|..22 |
  23. C | . | .. | . |
  24. C |. | . . |. |
  25. C 9........21......10 C |
  26. C | 7______6__|______5
  27. C | / .. | /
  28. C | / . | /
  29. C | 8......25....|...4
  30. C | / . | /
  31. C | / A . | /
  32. C |/_______________|/____>ksi
  33. C 1 2 3
  34. C 0. 1.
  35. C
  36. C
  37. C
  38. C************************************************************************
  39. REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  40. PARAMETER (NPG1=5,NPG2=NPG1*NPG1)
  41. REAL*8 X1(NPG1),PG1(NPG1)
  42. REAL*8 X2(NPG2),Y2(NPG2),PG2(NPG2)
  43. CHARACTER NOM2*4
  44. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  45. DIMENSION F2N(9,NPG2),G2R(2,9,NPG2)
  46. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  47. DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3)
  48. DIMENSION I12(27)
  49. * SAVE XA,XB,XC,XD,I12
  50. DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/
  51. DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/
  52. DATA I12/1,2,3,4,5,6,7,8,25,9,21,10,22,11,23,12,24,27,13,14,15,16,
  53. & 17,18,19,20,26/
  54. C***
  55. 0 XREN<3pan style="color: #009900;">(1,1)=0.D0
  56. XREF(2,1)=0.D0
  57. XREF(3,1)=0.D0
  58.  
  59. XREF(1,2)=0.5D0
  60. XREF(2,2)=0.D0
  61. XREF(3,2)=0.D0
  62.  
  63. XREF(1,3)=1.D0
  64. XREF(2,3)=0.D0
  65. XREF(3,3)=0.D0
  66.  
  67. XREF(1,4)=1.D0
  68. XREF(2,4)=0.5D0
  69. XREF(3,4)=0.D0
  70.  
  71. XREF(1,5)=1.D0
  72. XREF(2,5)=1.D0
  73. XREF(3,5)=0.D0
  74.  
  75. XREF(1,6)=0.5D0
  76. XREF(2,6)=1.D0
  77. XREF(3,6)=0.D0
  78.  
  79. XREF(1,7)=0.D0
  80. XREF(2,7)=1.D0
  81. XREF(3,7)=0.D0
  82.  
  83. XREF(1,8)=0.D0
  84. XREF(2,8)=0.5D0
  85. XREF(3,8)=0.D0
  86.  
  87. XREF(1,13)=0.D0
  88. XREF(2,13)=0.D0
  89. XREF(3,13)=1.D0
  90.  
  91. XREF(1,14)=0.5D0
  92. XREF(2,14)=0.D0
  93. XREF(3,14)=1.D0
  94.  
  95. XREF(1,15)=1.D0
  96. XREF(2,15)=0.D0
  97. XREF(3,15)=1.D0
  98.  
  99. XREF(1,16)=1.D0
  100. XREF(2,16)=0.5D0
  101. XREF(3,16)=1.D0
  102.  
  103. XREF(1,17)=1.D0
  104. XREF(2,17)=1.D0
  105. XREF(3,17)=1.D0
  106.  
  107. XREF(1,18)=0.5D0
  108. XREF(2,18)=1.D0
  109. XREF(3,18)=1.D0
  110.  
  111. XREF(1,19)=0.D0
  112. XREF(2,19)=1.D0
  113. XREF(3,19)=1.D0
  114.  
  115. XREF(1,20)=0.D0
  116. XREF(2,20)=0.5D0
  117. XREF(3,20)=1.D0
  118.  
  119. XREF(1,9)=0.D0
  120. XREF(2,9)=0.D0
  121. XREF(3,9)=0.5D0
  122.  
  123. XREF(1,10)=1.D0
  124. XREF(2,10)=0.D0
  125. XREF(3,10)=0.5D0
  126.  
  127. XREF(1,11)=1.D0
  128. XREF(2,11)=1.D0
  129. XREF(3,11)=0.5D0
  130.  
  131. XREF(1,12)=0.D0
  132. XREF(2,12)=1.D0
  133. XREF(3,12)=0.5D0
  134.  
  135. XREF(1,21)=0.5D0
  136. XREF(2,21)=0.D0
  137. XREF(3,21)=0.5D0
  138.  
  139. XREF(1,22)=1.D0
  140. XREF(2,22)=0.5D0
  141. XREF(3,22)=0.5D0
  142.  
  143. XREF(1,23)=0.5D0
  144. XREF(2,23)=1.D0
  145. XREF(3,23)=0.5D0
  146.  
  147. XREF(1,24)=0.D0
  148. XREF(2,24)=0.5D0
  149. XREF(3,24)=0.5D0
  150.  
  151. XREF(1,25)=0.5D0
  152. XREF(2,25)=0.5D0
  153. XREF(3,25)=0.D0
  154.  
  155. XREF(1,26)=0.5D0
  156. XREF(2,26)=0.5D0
  157. XREF(3,26)=1.D0
  158.  
  159. XREF(1,27)=0.5D0
  160. XREF(2,27)=0.5D0
  161. XREF(3,27)=0.5D0
  162.  
  163.  
  164. CALL CALUHG(U,H,NG)
  165. C
  166. NG2=NG*NG
  167. IF(NG2.GT.25)RETURN
  168.  
  169. A=0.D0
  170. B=1.D0
  171. C=0.D0
  172. D=1.D0
  173. E=0.D0
  174. F=1.D0
  175. CALL CALG2(A,B,C,D,NG,H,U,X2,Y2,PG2)
  176. CALL CALG1(E,F,NG,H,U,X1,PG1)
  177.  
  178. LL=0
  179. DO 1 L=1,NG2
  180. DO 2 L1=1,NG
  181. LL=LL+1
  182. X(L)=X2(L)
  183. Y(L)=Y2(L)
  184. Z(L)=X1(L1)
  185. PG(LL)=PG1(L1)*PG2(L)
  186. C? write(6,*)'LL=',LL,X(L),Y(L),Z(L)
  187. C
  188. XX(1)=X(L)
  189. XX(2)=Y(L)
  190. XX(3)=Z(L)
  191.  
  192. IF(NOM2.EQ.'PRP0')THEN
  193. FM(1,LL)=1.D0
  194. CALL INITD(GM,(3*NPG),0.D0)
  195. ELSEIF(NOM2.EQ.'PRP1')THEN
  196. FM(1,LL)=EQPL3P(XX,XB,XC,XD)/
  197. & EQPL3P(XA,XB,XC,XD)
  198. FM(2,LL)=EQPL3P(XX,XA,XC,XD)/
  199. & EQPL3P(XB,XA,XC,XD)
  200. FM(3,LL)=EQPL3P(XX,XA,XB,XD)/
  201. & EQPL3P(XC,XA,XB,XD)
  202. FM(4,LL)=EQPL3P(XX,XA,XB,XC)/
  203. & EQPL3P(XD,XA,XB,XC)
  204. CALL INITD(GM,(12*NPG),0.D0)
  205. ELSEIF(NOM2.EQ.'PFP1')THEN
  206. FM(1,LL)=-(X(L)-1.D0)*(Y(L)-1.D0)*(Z(L)-1.D0)
  207. FM(2,LL)=X(L)*(Y(L)-1.D0)*(Z(L)-1.D0)
  208. FM(3,LL)=-X(L)*Y(L)*(Z(L)-1.D0)
  209. FM(4,LL)=(X(L)-1.D0)*Y(L)*(Z(L)-1.D0)
  210. FM(5,LL)=(X(L)-1.D0)*(Y(L)-1.D0)*Z(L)
  211. FM(6,LL)=-X(L)*(Y(L)-1.D0)*Z(L)
  212. FM(7,LL)=X(L)*Y(L)*Z(L)
  213. FM(8,LL)=-(X(L)-1.D0)*Y(L)*Z(L)
  214.  
  215. GM(1,1,LL)=-(Y(L)-1.D0)*(Z(L)-1.D0)
  216. GM(2,1,LL)=-(X(L)-1.D0)*(Z(L)-1.D0)
  217. GM(3,1,LL)=-(X(L)-1.D0)*(Y(L)-1.D0)
  218. C
  219. GM(1,2,LL)=(Y(L)-1.D0)*(Z(L)-1.D0)
  220. GM(2,2,LL)=X(L)*(Z(L)-1.D0)
  221. GM(3,2,LL)=X(L)*(Y(L)-1.D0)
  222. C
  223. GM(1,3,LL)=-Y(L)*(Z(L)-1.D0)
  224. GM(2,3,LL)=-X(L)*(Z(L)-1.D0)
  225. GM(3,3,LL)=-X(L)*Y(L)
  226. C
  227. GM(1,4,LL)=Y(L)*(Z(L)-1.D0)
  228. GM(2,4,LL)=(X(L)-1.D0)*(Z(L)-1.D0)
  229. GM(3,4,LL)=(X(L)-1.D0)*Y(L)
  230. C
  231. GM(1,5,LL)=(Y(L)-1.D0)*Z(L)
  232. GM(2,5,LL)=(X(L)-1.D0)*Z(L)
  233. GM(3,5,LL)=(X(L)-1.D0)*(Y(L)-1.D0)
  234. C
  235. GM(1,6,LL)=-(Y(L)-1.D0)*Z(L)
  236. GM(2,6,LL)=-X(L)*Z(L)
  237. GM(3,6,LL)=-X(L)*(Y(L)-1.D0)
  238. C
  239. GM(1,7,LL)=Y(L)*Z(L)
  240. GM(2,7,LL)=X(L)*Z(L)
  241. GM(3,7,LL)=X(L)*Y(L)
  242. C
  243. GM(1,8,LL)=-Y(L)*Z(L)
  244. GM(2,8,LL)=-(X(L)-1.D0)*Z(L)
  245. GM(3,8,LL)=-(X(L)-1.D0)*Y(L)
  246. C
  247. ENDIF
  248.  
  249. C
  250. F2N(1,L)=(X(L)-1.D0)*(Y(L)-1.D0)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)
  251. F2N(2,L)=-4.D0*X(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)
  252. F2N(3,L)=X(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)
  253. F2N(4,L)=-4.D0*X(L)*Y(L)*(2.D0*X(L)-1.D0)*(Y(L)-1.D0)
  254. F2N(5,L)=X(L)*Y(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)
  255. F2N(6,L)=-4.D0*X(L)*Y(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)
  256. F2N(7,L)=Y(L)*(2.D0*Y(L)-1.D0)*(2.D0*X(L)-1.D0)*(X(L)-1.D0)
  257. F2N(8,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(X(L)-1.D0)*(2.D0*X(L)-1.D0)
  258. F2N(9,L)=16.D0*X(L)*Y(L)*(X(L)-1.D0)*(Y(L)-1.D0)
  259. C
  260. G2R(1,1,L)=(Y(L)-1.D0)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-3.D0)
  261. G2R(2,1,L)=(X(L)-1.D0)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-3.D0)
  262. G2R(1,2,L)=-4.D0*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)
  263. G2R(2,2,L)=-4.D0*X(L)*(X(L)-1.D0)*(4.D0*Y(L)-3.D0)
  264. G2R(1,3,L)=(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)*(4.D0*X(L)-1.D0)
  265. G2R(2,3,L)=X(L)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-3.D0)
  266. G2R(1,4,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(4.D0*X(L)-1.D0)
  267. G2R(2,4,L)=-4.D0*X(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)
  268. G2R(1,5,L)=Y(L)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-1.D0)
  269. G2R(2,5,L)=X(L)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-1.D0)
  270. G2R(1,6,L)=-4.D0*Y(L)*(2.D0*Y(L)-1.D0)*(2.D0*X(L)-1.D0)
  271. G2R(2,6,L)=-4.D0*X(L)*(X(L)-1.D0)*(4.D0*Y(L)-1.D0)
  272. G2R(1,7,L)=Y(L)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-3.D0)
  273. G2R(2,7,L)=(2.D0*X(L)-1.D0)*(X(L)-1.D0)*(4.D0*Y(L)-1.D0)
  274. G2R(1,8,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(4.D0*X(L)-3.D0)
  275. G2R(2,8,L)=-4.D0*(X(L)-1.D0)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)
  276. G2R(1,9,L)=16.D0*Y(L)*(Y(L)-1.D0)*(2.D0*X(L)-1.D0)
  277. G2R(2,9,L)=16.D0*X(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)
  278.  
  279. DO 111 I=1,9
  280. I1=I12(I)
  281. I9=I12(I+9)
  282. I18=I12(I+18)
  283. FN(I1,LL)=F2N(I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)
  284. FN(I9,LL)=F2N(I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)
  285. FN(I18,LL)=F2N(I,L)*Z(L)*(2.D0*Z(L)-1.D0)
  286.  
  287. GR(1,I1,LL)=G2R(1,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)
  288. GR(2,I1,LL)=G2R(2,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)
  289. GR(3,I1,LL)=F2N(I,L)*(4.D0*Z(L)-3.D0)
  290.  
  291. GR(1,I9,LL)=G2R(1,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)
  292. GR(2,I9,LL)=G2R(2,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)
  293. GR(3,I9,LL)=F2N(I,L)*(-8.D0*Z(L)+4.D0)
  294.  
  295. GR(1,I18,LL)=G2R(1,I,L)*Z(L)*(2.D0*Z(L)-1.D0)
  296. GR(2,I18,LL)=G2R(2,I,L)*Z(L)*(2.D0*Z(L)-1.D0)
  297. GR(3,I18,LL)=F2N(I,L)*(4.D0*Z(L)-1.D0)
  298.  
  299. 111 CONTINUE
  300. C
  301. 2 CONTINUE
  302. 1 CONTINUE
  303.  
  304. C
  305. C WRITE(6,101)
  306. C WRITE(6,*)' FM '
  307. C WRITE(6,1002)FM
  308. C WRITE(6,*)' X '
  309. C WRITE(6,1008)X
  310. C WRITE(6,*)' Y '
  311. C WRITE(6,1008)Y
  312. C WRITE(6,*)' Z '
  313. C WRITE(6,1008)Z
  314. C WRITE(6,*)' GM '
  315. C WRITE(6,1002)GM
  316. C WRITE(6,*)' F2N'
  317. C WRITE(6,1002)F2N
  318.  
  319. C WRITE(6,*)' GR'
  320. C do 8705 l=1,npg
  321. C write(6,*)' l=',l
  322. C WRITE(6,1002)((GR(i,j,l),i=1,nd),j=1,np)
  323. C8705 continue
  324. C WRITE(6,101)
  325.  
  326. C write(6,*)' RET PB2703 '
  327. RETURN
  328. 1002 FORMAT(10(1X,1PD11.4))
  329. 1008 FORMAT( 8(1X,1PD11.4))
  330. 1001 FORMAT(20(1X,I5))
  331. 101 FORMAT(1X,'... SUBPB2703 ... FM,GM,F2N,GR ',9(10H..........)/)
  332. C
  333. END
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  

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