Télécharger pb442.eso

Retour à la liste

Numérotation des lignes :

  1. C PB442 SOURCE CHAT 05/01/13 02:10:35 5004
  2. SUBROUTINE PB442(X,Y,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 : Iso-Q2 (P1/P0)
  8. C
  9. C ^ eta
  10. C |
  11. C 1 n7_____n6_______ n5
  12. C | | |
  13. C | x x | x x |
  14. C | x 4 x | x 3 x |
  15. C 1/2|_______|_______|n4
  16. C |n8 |n9 |
  17. C | x x | x x |
  18. C | x 1 x | x 2 x |
  19. C |_______|_______|______>ksi
  20. C 0 1/2 1
  21. C n1 n2 n3
  22. C************************************************************************
  23.  
  24. REAL*8 X(NPG),Y(NPG)
  25. REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  26. REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  27. REAL*8 A,B,C,D,U(6),H(6)
  28. CHARACTER*4 NOM2
  29. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  30. C NPG=16 !!! NG=2 !!!
  31. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  32.  
  33. CALL CALUHG(U,H,NG)
  34.  
  35. C OMEGA 1
  36.  
  37. A=0.D0
  38. B=0.5D0
  39. C=0.D0
  40. D=0.5D0
  41. CALL CALG2(A,B,C,D,NG,H,U,X,Y,PG)
  42.  
  43. DO 1 L=1,4
  44. C
  45. FN(1,L)=(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L))
  46. GR(1,1,L)=-2.D0*(1.D0-2.D0*Y(L))
  47. GR(2,1,L)=-2.D0*(1.D0-2.D0*X(L))
  48.  
  49. FN(2,L)=2.D0*X(L)*(1.D0-2.D0*Y(L))
  50. GR(1,2,L)=2.D0*(1.D0-2.D0*Y(L))
  51. GR(2,2,L)=-4.D0*X(L)
  52.  
  53. FN(3,L)=0.D0
  54. GR(1,3,L)=0.D0
  55. GR(2,3,L)=0.D0
  56.  
  57. FN(4,L)=0.D0
  58. GR(1,4,L)=0.D0
  59. GR(2,4,L)=0.D0
  60.  
  61. FN(5,L)=0.D0
  62. GR(1,5,L)=0.D0
  63. GR(2,5,L)=0.D0
  64.  
  65. FN(6,L)=0.D0
  66. GR(1,6,L)=0.D0
  67. GR(2,6,L)=0.D0
  68.  
  69. FN(7,L)=0.D0
  70. GR(1,7,L)=0.D0
  71. GR(2,7,L)=0.D0
  72.  
  73. FN(8,L)=2.D0*Y(L)*(1.D0-2.D0*X(L))
  74. GR(1,8,L)=-4.D0*Y(L)
  75. GR(2,8,L)=2.D0*(1.D0-2.D0*X(L))
  76.  
  77. FN(9,L)=4.D0*X(L)*Y(L)
  78. GR(1,9,L)=4.D0*Y(L)
  79. GR(2,9,L)=4.D0*X(L)
  80.  
  81. C
  82. IF(NOM2.EQ.'MCP0')THEN
  83. FM(1,L)=1.D0
  84. GM(1,1,L)=0.D0
  85. GM(2,1,L)=0.D0
  86. ELSEIF(NOM2.EQ.'MCP1')THEN
  87. FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
  88. FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
  89. FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
  90. ELSEIF(NOM2.EQ.'MCF1')THEN
  91. FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
  92. FM(2,L)=-X(L)*(Y(L)-1.D0)
  93. FM(3,L)= X(L)*Y(L)
  94. FM(4,L)=-Y(L)*(X(L)-1.D0)
  95.  
  96. GM(1,1,L)=Y(L)-1.D0
  97. GM(2,1,L)=X(L)-1.D0
  98. GM(1,2,L)=-(Y(L)-1.D0)
  99. GM(2,2,L)=-X(L)
  100. GM(1,3,L)=Y(L)
  101. GM(2,3,L)=X(L)
  102. GM(1,4,L)=-Y(L)
  103. GM(2,4,L)=-(X(L)-1.D0)
  104. ENDIF
  105.  
  106. 1 CONTINUE
  107.  
  108. C OMEGA 2
  109.  
  110. A=0.5D0
  111. B=1.D0
  112. C=0.D0
  113. D=0.5D0
  114. CALL CALG2(A,B,C,D,NG,H,U,X(5),Y(5),PG(5))
  115.  
  116. DO 2 L=5,8
  117. C
  118. FN(1,L)=0.D0
  119. GR(1,1,L)=0.D0
  120. GR(2,1,L)=0.D0
  121.  
  122. FN(2,L)=2.D0*(1.D0-X(L))*(1.D0-2.D0*Y(L))
  123. GR(1,2,L)=-2.D0*(1.D0-2.D0*Y(L))
  124. GR(2,2,L)=-4.D0*(1.D0-X(L))
  125.  
  126. FN(3,L)=-(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L))
  127. GR(1,3,L)=2.D0*(1.D0-2.D0*Y(L))
  128. GR(2,3,L)=2.D0*(1.D0-2.D0*X(L))
  129.  
  130. FN(4,L)=-2.D0*Y(L)*(1.D0-2.D0*X(L))
  131. GR(1,4,L)=4.D0*Y(L)
  132. GR(2,4,L)=-2.D0*(1.D0-2.D0*X(L))
  133.  
  134. FN(5,L)=0.D0
  135. GR(1,5,L)=0.D0
  136. GR(2,5,L)=0.D0
  137.  
  138. FN(6,L)=0.D0
  139. GR(1,6,L)=0.D0
  140. GR(2,6,L)=0.D0
  141.  
  142. FN(7,L)=0.D0
  143. GR(1,7,L)=0.D0
  144. GR(2,7,L)=0.D0
  145.  
  146. FN(8,L)=0.D0
  147. GR(1,8,L)=0.D0
  148. GR(2,8,L)=0.D0
  149.  
  150. FN(9,L)=4.D0*(1.D0-X(L))*Y(L)
  151. GR(1,9,L)=-4.D0*Y(L)
  152. GR(2,9,L)=4.D0*(1.D0-X(L))
  153.  
  154. C
  155. IF(NOM2.EQ.'MCP0')THEN
  156. FM(1,L)=1.D0
  157. GM(1,1,L)=0.D0
  158. GM(2,1,L)=0.D0
  159. ELSEIF(NOM2.EQ.'MCP1')THEN
  160. FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
  161. FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
  162. FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
  163. ELSEIF(NOM2.EQ.'MCF1')THEN
  164. FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
  165. FM(2,L)=-X(L)*(Y(L)-1.D0)
  166. FM(3,L)= X(L)*Y(L)
  167. FM(4,L)=-Y(L)*(X(L)-1.D0)
  168.  
  169. GM(1,1,L)=Y(L)-1.D0
  170. GM(2,1,L)=X(L)-1.D0
  171. GM(1,2,L)=-(Y(L)-1.D0)
  172. GM(2,2,L)=-X(L)
  173. GM(1,3,L)=Y(L)
  174. GM(2,3,L)=X(L)
  175. GM(1,4,L)=-Y(L)
  176. GM(2,4,L)=-(X(L)-1.D0)
  177. ENDIF
  178.  
  179. 2 CONTINUE
  180.  
  181. C OMEGA 3
  182.  
  183. A=0.5D0
  184. B=1.D0
  185. C=0.5D0
  186. D=1.D0
  187. CALL CALG2(A,B,C,D,NG,H,U,X(9),Y(9),PG(9))
  188.  
  189. DO 3 L=9,12
  190. C
  191. FN(1,L)=0.D0
  192. GR(1,1,L)=0.D0
  193. GR(2,1,L)=0.D0
  194.  
  195. FN(2,L)=0.D0
  196. GR(1,2,L)=0.D0
  197. GR(2,2,L)=0.D0
  198.  
  199. FN(3,L)=0.D0
  200. GR(1,3,L)=0.D0
  201. GR(2,3,L)=0.D0
  202.  
  203. FN(4,L)=-2.D0*(1.D0-2.D0*X(L))*(1.D0-Y(L))
  204. GR(1,4,L)=4.D0*(1.D0-Y(L))
  205. GR(2,4,L)=2.D0*(1.D0-2.D0*X(L))
  206.  
  207. FN(5,L)=(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L))
  208. GR(1,5,L)=-2.D0*(1.D0-2.D0*Y(L))
  209. GR(2,5,L)=-2.D0*(1.D0-2.D0*X(L))
  210.  
  211. FN(6,L)=-2.D0*(1.D0-2.D0*Y(L))*(1.D0-X(L))
  212. GR(1,6,L)=2.D0*(1.D0-2.D0*Y(L))
  213. GR(2,6,L)=4.D0*(1.D0-X(L))
  214.  
  215. FN(7,L)=0.D0
  216. GR(1,7,L)=0.D0
  217. GR(2,7,L)=0.D0
  218.  
  219. FN(8,L)=0.D0
  220. GR(1,8,L)=0.D0
  221. GR(2,8,L)=0.D0
  222.  
  223. FN(9,L)=4.D0*(1.D0-X(L))*(1.D0-Y(L))
  224. GR(1,9,L)=-4.D0*(1.D0-Y(L))
  225. GR(2,9,L)=-4.D0*(1.D0-X(L))
  226.  
  227. C
  228. IF(NOM2.EQ.'MCP0')THEN
  229. FM(1,L)=1.D0
  230. GM(1,1,L)=0.D0
  231. GM(2,1,L)=0.D0
  232. ELSEIF(NOM2.EQ.'MCP1')THEN
  233. FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
  234. FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
  235. FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
  236. ELSEIF(NOM2.EQ.'MCF1')THEN
  237. FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
  238. FM(2,L)=-X(L)*(Y(L)-1.D0)
  239. FM(3,L)= X(L)*Y(L)
  240. FM(4,L)=-Y(L)*(X(L)-1.D0)
  241.  
  242. GM(1,1,L)=Y(L)-1.D0
  243. GM(2,1,L)=X(L)-1.D0
  244. GM(1,2,L)=-(Y(L)-1.D0)
  245. GM(2,2,L)=-X(L)
  246. GM(1,3,L)=Y(L)
  247. GM(2,3,L)=X(L)
  248. GM(1,4,L)=-Y(L)
  249. GM(2,4,L)=-(X(L)-1.D0)
  250. ENDIF
  251.  
  252. 3 CONTINUE
  253.  
  254. C OMEGA 4
  255.  
  256. A=0.D0
  257. B=0.5D0
  258. C=0.5D0
  259. D=1.D0
  260. CALL CALG2(A,B,C,D,NG,H,U,X(13),Y(13),PG(13))
  261.  
  262. DO 4 L=13,16
  263. C
  264. FN(1,L)=0.D0
  265. GR(1,1,L)=0.D0
  266. GR(2,1,L)=0.D0
  267.  
  268. FN(2,L)=0.D0
  269. GR(1,2,L)=0.D0
  270. GR(2,2,L)=0.D0
  271.  
  272. FN(3,L)=0.D0
  273. GR(1,3,L)=0.D0
  274. GR(2,3,L)=0.D0
  275.  
  276. FN(4,L)=0.D0
  277. GR(1,4,L)=0.D0
  278. GR(2,4,L)=0.D0
  279.  
  280. FN(5,L)=0.D0
  281. GR(1,5,L)=0.D0
  282. GR(2,5,L)=0.D0
  283.  
  284. FN(6,L)=-2.D0*X(L)*(1.D0-2.D0*Y(L))
  285. GR(1,6,L)=-2.D0*(1.D0-2.D0*Y(L))
  286. GR(2,6,L)=4.D0*X(L)
  287.  
  288. FN(7,L)=-(1.D0-2.D0*Y(L))*(1.D0-2.D0*X(L))
  289. GR(1,7,L)=2.D0*(1.D0-2.D0*Y(L))
  290. GR(2,7,L)=2.D0*(1.D0-2.D0*X(L))
  291.  
  292. FN(8,L)=2.D0*(1.D0-2.D0*X(L))*(1.D0-Y(L))
  293. GR(1,8,L)=-4.D0*(1.D0-Y(L))
  294. GR(2,8,L)=-2.D0*(1.D0-2.D0*X(L))
  295.  
  296. FN(9,L)=4.D0*X(L)*(1.D0-Y(L))
  297. GR(1,9,L)=4.D0*(1.D0-Y(L))
  298. GR(2,9,L)=-4.D0*X(L)
  299.  
  300. C
  301. IF(NOM2.EQ.'MCP0')THEN
  302. FM(1,L)=1.D0
  303. GM(1,1,L)=0.D0
  304. GM(2,1,L)=0.D0
  305. ELSEIF(NOM2.EQ.'MCP1')THEN
  306. FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
  307. FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
  308. FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
  309. ELSEIF(NOM2.EQ.'MCF1')THEN
  310. FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
  311. FM(2,L)=-X(L)*(Y(L)-1.D0)
  312. FM(3,L)= X(L)*Y(L)
  313. FM(4,L)=-Y(L)*(X(L)-1.D0)
  314.  
  315. GM(1,1,L)=Y(L)-1.D0
  316. GM(2,1,L)=X(L)-1.D0
  317. GM(1,2,L)=-(Y(L)-1.D0)
  318. GM(2,2,L)=-X(L)
  319. GM(1,3,L)=Y(L)
  320. GM(2,3,L)=X(L)
  321. GM(1,4,L)=-Y(L)
  322. GM(2,4,L)=-(X(L)-1.D0)
  323. ENDIF
  324.  
  325. 4 CONTINUE
  326.  
  327. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  328. C WRITE(6,*)'X'
  329. C WRITE(6,1002)X
  330. C WRITE(6,*)'Y'
  331. C WRITE(6,1002)Y
  332. C WRITE(6,*)'FN'
  333. C do 1782 l=1,4
  334. C WRITE(6,1002)FN(1,L),FN(2,L+4),FN(9,L+8),FN(8,L+12)
  335. C WRITE(6,1002)FN(2,L),FN(3,L+4),FN(4,L+8),FN(9,L+12)
  336. C WRITE(6,1002)FN(9,L),FN(4,L+4),FN(5,L+8),FN(6,L+12)
  337. C WRITE(6,1002)FN(8,L),FN(9,L+4),FN(6,L+8),FN(7,L+12)
  338. C1782 continue
  339. C WRITE(6,*)'GM'
  340. C WRITE(6,1002)GM
  341. C WRITE(6,*)'FM'
  342. C WRITE(6,1002)FM
  343.  
  344. RETURN
  345. 1002 FORMAT(10(1X,1PE11.4))
  346. 1001 FORMAT(20(1X,I5))
  347. C
  348. END
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  

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