Télécharger pb663.eso

Retour à la liste

Numérotation des lignes :

  1. C PB663 SOURCE CHAT 05/01/13 02:10:51 5004
  2. SUBROUTINE PB663(X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NGG,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 (iso P1/P0 nc) PR18
  8. C
  9. C P4 equation du plan zeta=0
  10. C P5 equation du plan zeta=1
  11. C ^ zeta etc
  12. C | 14 ^ eta |X3 3
  13. C | / \ / |Y3 o
  14. C | / \ / |\
  15. C | 15_____\13 / | \
  16. C | / \ /\ / P3 | \ P2
  17. C | / \ / \ / | \
  18. C |/_____\/____\ / | \
  19. C 10 11 12 / | \
  20. C | / 1 o______o 2
  21. C | 9 / |X1 |X2
  22. C | / \ / |Y1 P1 |Y2
  23. C | / \ /
  24. C | 18_____17
  25. C | / \ /\ XI abcisse intersection P2 et ksi
  26. C | / \ / \ YI ordonnée intersection P2 et eta
  27. C |/_____\/____\
  28. C 7 16 8
  29. C | / fct de formes N1=P2*P5/F1C
  30. C | 5 tel que N1=1 au pt 1
  31. C | / \
  32. C | / \
  33. C | 6_____\4
  34. C | / \ /\
  35. C | / \ / \
  36. C |/_____\/____\ ____________________>ksi
  37. C 1 2 3
  38. C
  39. C
  40. C************************************************************************
  41.  
  42. CHARACTER*4 NOM2
  43. REAL*8 X(NPG),Y(NPG),Z(NPG)
  44. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  45. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  46. DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3)
  47. SAVE XA,XB,XC,XD
  48. DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/
  49. DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/
  50.  
  51. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  52. C
  53.  
  54. R2=SQRT(2.D0)
  55. R22=R2*0.5D0
  56.  
  57. DO 1 K=1,8
  58. C
  59. IF(K.EQ.1)THEN
  60. X1=0.D0
  61. Y1=0.D0
  62. X2=R22
  63. Y2=0.D0
  64. X3=0.D0
  65. Y3=R22
  66. Z1=0.D0
  67. Z2=0.5D0
  68. XI=R22
  69. YI=R22
  70. ELSEIF(K.EQ.2)THEN
  71. X1=R22
  72. Y1=0.D0
  73. X2=R2
  74. Y2=0.D0
  75. X3=R22
  76. Y3=R22
  77. Z1=0.D0
  78. Z2=0.5D0
  79. XI=R2
  80. YI=R2
  81. ELSEIF(K.EQ.3)THEN
  82. X1=0.D0
  83. Y1=R22
  84. X2=R22
  85. Y2=R22
  86. X3=0.D0
  87. Y3=R2
  88. Z1=0.D0
  89. Z2=0.5D0
  90. XI=R2
  91. YI=R2
  92. ELSEIF(K.EQ.4)THEN
  93. X1=R22
  94. Y1=R22
  95. X2=0.D0
  96. Y2=R22
  97. X3=R22
  98. Y3=0.D0
  99. Z1=0.D0
  100. Z2=0.5D0
  101. XI=R22
  102. YI=R22
  103. ELSEIF(K.EQ.5)THEN
  104. X1=0.D0
  105. Y1=0.D0
  106. X2=R22
  107. Y2=0.D0
  108. X3=0.D0
  109. Y3=R22
  110. Z1=0.5D0
  111. Z2=1.D0
  112. XI=R22
  113. YI=R22
  114. ELSEIF(K.EQ.6)THEN
  115. X1=R22
  116. Y1=0.D0
  117. X2=R2
  118. Y2=0.D0
  119. X3=R22
  120. Y3=R22
  121. Z1=0.5D0
  122. Z2=1.D0
  123. XI=R2
  124. YI=R2
  125. ELSEIF(K.EQ.7)THEN
  126. X1=0.D0
  127. Y1=R22
  128. X2=R22
  129. Y2=R22
  130. X3=0.D0
  131. Y3=R2
  132. Z1=0.5D0
  133. Z2=1.D0
  134. XI=R2
  135. YI=R2
  136. ELSEIF(K.EQ.8)THEN
  137. X1=R22
  138. Y1=R22
  139. X2=0.D0
  140. Y2=R22
  141. X3=R22
  142. Y3=0.D0
  143. Z1=0.5D0
  144. Z2=1.D0
  145. XI=R22
  146. YI=R22
  147. ENDIF
  148.  
  149. K0=(K-1)*NGG
  150. CALL KHPRM(X(K0+1),Y(K0+1),Z(K0+1),PG(K0+1),NGG,
  151. &X1,Y1,X2,Y3,Z1,Z2)
  152. C write(6,*)' KHPRM NGG=',ngg
  153. C write(6,1002)(x(ii),ii=1,ngg)
  154. C write(6,1002)(y(ii),ii=1,ngg)
  155. C write(6,1002)(z(ii),ii=1,ngg)
  156.  
  157. P1C=Y3-Y1
  158. P2C=X1/XI+Y1/YI-1.D0
  159. P3C=X2-X1
  160. P4C=Z2-Z1
  161. P5C=Z1-Z2
  162. C write(6,*)'PiC '
  163. C write(6,1002)P1C,P2C,P3C,P4C,P5C
  164.  
  165. DO 1 L=1,NGG
  166. P1=Y(L+K0)-Y1
  167. P2=X(L+K0)/XI+Y(L+K0)/YI-1.D0
  168. P3=X(L+K0)-X1
  169. P4=Z(L+K0)-Z1
  170. P5=Z(L+K0)-Z2
  171.  
  172. F1C=P2C*P5C
  173. F1=P2*P5/F1C
  174.  
  175. F2C=P3C*P5C
  176. F2=P3*P5/F2C
  177.  
  178. F3C=P1C*P5C
  179. F3=P1*P5/F3C
  180.  
  181. F4C=P2C*P4C
  182. F4=P2*P4/F4C
  183.  
  184. F5C=P3C*P4C
  185. F5=P3*P4/F5C
  186.  
  187. F6C=P1C*P4C
  188. F6=P1*P4/F6C
  189.  
  190. C write(6,*)'FiC'
  191. C write(6,1002)F1C,F2C,F3C,F4C,F5C,F6C
  192.  
  193. GX1=P5/XI/F1C
  194. GY1=P5/YI/F1C
  195. GZ1=P2/F1C
  196.  
  197. GX2=P5/F2C
  198. GY2=0.D0
  199. GZ2=P3/F2C
  200.  
  201. GX3=0.D0
  202. GY3=P5/F3C
  203. GZ3=P1/F3C
  204.  
  205. GX4=P4/XI/F4C
  206. GY4=P4/YI/F4C
  207. GZ4=P2/F4C
  208.  
  209. GX5=P4/F5C
  210. GY5=0.D0
  211. GZ5=P3/F5C
  212.  
  213. GX6=0.D0
  214. GY6=P4/F6C
  215. GZ6=P1/F6C
  216.  
  217. C write(6,1002)F1,f2,f3,f4,f5,f6
  218. C
  219. C write(6,1002)gx1,gx2,gx3,gx4,gx5,gx6
  220. C write(6,1002)gy1,gy2,gy3,gy4,gy5,gy6
  221. C write(6,1002)gz1,gz2,gz3,gz4,gz5,gz6
  222.  
  223. LL=K0+L
  224.  
  225. IF(K.EQ.1)THEN
  226.  
  227. FN( 1,LL)=F1
  228. FN( 2,LL)=F2
  229. FN( 6,LL)=F3
  230. FN( 7,LL)=F4
  231. FN(16,LL)=F5
  232. FN(18,LL)=F6
  233.  
  234. GR(1, 1,LL)=GX1
  235. GR(1, 2,LL)=GX2
  236. GR(1, 6,LL)=GX3
  237. GR(1, 7,LL)=GX4
  238. GR(1,16,LL)=GX5
  239. GR(1,18,LL)=GX6
  240.  
  241. GR(2, 1,LL)=GY1
  242. GR(2, 2,LL)=GY2
  243. GR(2, 6,LL)=GY3
  244. GR(2, 7,LL)=GY4
  245. GR(2,16,LL)=GY5
  246. GR(2,18,LL)=GY6
  247.  
  248. GR(3, 1,LL)=GZ1
  249. GR(3, 2,LL)=GZ2
  250. GR(3, 6,LL)=GZ3
  251. GR(3, 7,LL)=GZ4
  252. GR(3,16,LL)=GZ5
  253. GR(3,18,LL)=GZ6
  254.  
  255. ELSEIF(K.EQ.2)THEN
  256.  
  257. FN( 2,LL)=F1
  258. FN( 3,LL)=F2
  259. FN( 4,LL)=F3
  260. FN(16,LL)=F4
  261. FN( 8,LL)=F5
  262. FN(17,LL)=F6
  263.  
  264. GR(1, 2,LL)=GX1
  265. GR(1, 3,LL)=GX2
  266. GR(1, 4,LL)=GX3
  267. GR(1,16,LL)=GX4
  268. GR(1, 8,LL)=GX5
  269. GR(1,17,LL)=GX6
  270.  
  271. GR(2, 2,LL)=GY1
  272. GR(2, 3,LL)=GY2
  273. GR(2, 4,LL)=GY3
  274. GR(2,16,LL)=GY4
  275. GR(2, 8,LL)=GY5
  276. GR(2,17,LL)=GY6
  277.  
  278. GR(3, 2,LL)=GZ1
  279. GR(3, 3,LL)=GZ2
  280. GR(3, 4,LL)=GZ3
  281. GR(3,16,LL)=GZ4
  282. GR(3, 8,LL)=GZ5
  283. GR(3,17,LL)=GZ6
  284.  
  285. ELSEIF(K.EQ.3)THEN
  286.  
  287. FN( 6,LL)=F1
  288. FN( 4,LL)=F2
  289. FN( 5,LL)=F3
  290. FN(18,LL)=F4
  291. FN(17,LL)=F5
  292. FN( 9,LL)=F6
  293.  
  294. GR(1, 6,LL)=GX1
  295. GR(1, 4,LL)=GX2
  296. GR(1, 5,LL)=GX3
  297. GR(1,18,LL)=GX4
  298. GR(1,17,LL)=GX5
  299. GR(1, 9,LL)=GX6
  300.  
  301. GR(2, 6,LL)=GY1
  302. GR(2, 4,LL)=GY2
  303. GR(2, 5,LL)=GY3
  304. GR(2,18,LL)=GY4
  305. GR(2,17,LL)=GY5
  306. GR(2, 9,LL)=GY6
  307.  
  308. GR(3, 6,LL)=GZ1
  309. GR(3, 4,LL)=GZ2
  310. GR(3, 5,LL)=GZ3
  311. GR(3,18,LL)=GZ4
  312. GR(3,17,LL)=GZ5
  313. GR(3, 9,LL)=GZ6
  314.  
  315. ELSEIF(K.EQ.4)THEN
  316.  
  317. FN( 4,LL)=F1
  318. FN( 6,LL)=F2
  319. FN( 2,LL)=F3
  320. FN(17,LL)=F4
  321. FN(18,LL)=F5
  322. FN(16,LL)=F6
  323.  
  324. GR(1, 4,LL)=GX1
  325. GR(1, 6,LL)=GX2
  326. GR(1, 2,LL)=GX3
  327. GR(1,17,LL)=GX4
  328. GR(1,18,LL)=GX5
  329. GR(1,16,LL)=GX6
  330.  
  331. GR(2, 4,LL)=GY1
  332. GR(2, 6,LL)=GY2
  333. GR(2, 2,LL)=GY3
  334. GR(2,17,LL)=GY4
  335. GR(2,18,LL)=GY5
  336. GR(2,16,LL)=GY6
  337.  
  338. GR(3, 4,LL)=GZ1
  339. GR(3, 6,LL)=GZ2
  340. GR(3, 2,LL)=GZ3
  341. GR(3,17,LL)=GZ4
  342. GR(3,18,LL)=GZ5
  343. GR(3,16,LL)=GZ6
  344.  
  345. ELSEIF(K.EQ.5)THEN
  346.  
  347. FN( 7,LL)=F1
  348. FN(16,LL)=F2
  349. FN(18,LL)=F3
  350. FN(10,LL)=F4
  351. FN(11,LL)=F5
  352. FN(15,LL)=F6
  353.  
  354. GR(1, 7,LL)=GX1
  355. GR(1,16,LL)=GX2
  356. GR(1,18,LL)=GX3
  357. GR(1,10,LL)=GX4
  358. GR(1,11,LL)=GX5
  359. GR(1,15,LL)=GX6
  360.  
  361. GR(2, 7,LL)=GY1
  362. GR(2,16,LL)=GY2
  363. GR(2,18,LL)=GY3
  364. GR(2,10,LL)=GY4
  365. GR(2,11,LL)=GY5
  366. GR(2,15,LL)=GY6
  367.  
  368. GR(3, 7,LL)=GZ1
  369. GR(3,16,LL)=GZ2
  370. GR(3,18,LL)=GZ3
  371. GR(3,10,LL)=GZ4
  372. GR(3,11,LL)=GZ5
  373. GR(3,15,LL)=GZ6
  374.  
  375. ELSEIF(K.EQ.6)THEN
  376.  
  377. FN(16,LL)=F1
  378. FN( 8,LL)=F2
  379. FN(17,LL)=F3
  380. FN(11,LL)=F4
  381. FN(12,LL)=F5
  382. FN(13,LL)=F6
  383.  
  384. GR(1,16,LL)=GX1
  385. GR(1, 8,LL)=GX2
  386. GR(1,17,LL)=GX3
  387. GR(1,11,LL)=GX4
  388. GR(1,12,LL)=GX5
  389. GR(1,13,LL)=GX6
  390.  
  391. GR(2,16,LL)=GY1
  392. GR(2, 8,LL)=GY2
  393. GR(2,17,LL)=GY3
  394. GR(2,11,LL)=GY4
  395. GR(2,12,LL)=GY5
  396. GR(2,13,LL)=GY6
  397.  
  398. GR(3,16,LL)=GZ1
  399. GR(3, 8,LL)=GZ2
  400. GR(3,17,LL)=GZ3
  401. GR(3,11,LL)=GZ4
  402. GR(3,12,LL)=GZ5
  403. GR(3,13,LL)=GZ6
  404.  
  405. ELSEIF(K.EQ.7)THEN
  406.  
  407. FN(18,LL)=F1
  408. FN(17,LL)=F2
  409. FN( 9,LL)=F3
  410. FN(15,LL)=F4
  411. FN(13,LL)=F5
  412. FN(14,LL)=F6
  413.  
  414. GR(1,18,LL)=GX1
  415. GR(1,17,LL)=GX2
  416. GR(1, 9,LL)=GX3
  417. GR(1,15,LL)=GX4
  418. GR(1,13,LL)=GX5
  419. GR(1,14,LL)=GX6
  420.  
  421. GR(2,18,LL)=GY1
  422. GR(2,17,LL)=GY2
  423. GR(2, 9,LL)=GY3
  424. GR(2,15,LL)=GY4
  425. GR(2,13,LL)=GY5
  426. GR(2,14,LL)=GY6
  427.  
  428. GR(3,18,LL)=GZ1
  429. GR(3,17,LL)=GZ2
  430. GR(3, 9,LL)=GZ3
  431. GR(3,15,LL)=GZ4
  432. GR(3,13,LL)=GZ5
  433. GR(3,14,LL)=GZ6
  434.  
  435. ELSEIF(K.EQ.8)THEN
  436.  
  437. FN(17,LL)=F1
  438. FN(18,LL)=F2
  439. FN(16,LL)=F3
  440. FN(13,LL)=F4
  441. FN(15,LL)=F5
  442. FN(11,LL)=F6
  443.  
  444. GR(1,17,LL)=GX1
  445. GR(1,18,LL)=GX2
  446. GR(1,16,LL)=GX3
  447. GR(1,13,LL)=GX4
  448. GR(1,15,LL)=GX5
  449. GR(1,11,LL)=GX6
  450.  
  451. GR(2,17,LL)=GY1
  452. GR(2,18,LL)=GY2
  453. GR(2,16,LL)=GY3
  454. GR(2,13,LL)=GY4
  455. GR(2,15,LL)=GY5
  456. GR(2,11,LL)=GY6
  457.  
  458. GR(3,17,LL)=GZ1
  459. GR(3,18,LL)=GZ2
  460. GR(3,16,LL)=GZ3
  461. GR(3,13,LL)=GZ4
  462. GR(3,15,LL)=GZ5
  463. GR(3,11,LL)=GZ6
  464.  
  465. ENDIF
  466.  
  467. 1 CONTINUE
  468.  
  469. IF(NOM2.EQ.'MCP0')THEN
  470. DO 2 L=1,NPG
  471. FM(1,L)=1.D0
  472. GM(1,1,L)=0.D0
  473. GM(2,1,L)=0.D0
  474. GM(3,1,L)=0.D0
  475. 2 CONTINUE
  476. ELSEIF(NOM2.EQ.'MCP1')THEN
  477.  
  478. DO 3 LL=1,(2*NGG)
  479. FM(1,LL)=0.25D0
  480. FM(2,LL+2*NGG)=0.25D0
  481. FM(3,LL+4*NGG)=0.25D0
  482. FM(4,LL+6*NGG)=0.25D0
  483. 3 CONTINUE
  484. CALL INITD(GM,(12*NPG),0.D0)
  485. ELSEIF(NOM2.EQ.'MCF1')THEN
  486. DO 4 L=1,NPG
  487. FM(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  488. FM(2,L)=-X(L)*(Z(L)-1.D0)/R2
  489. FM(3,L)=-Y(L)*(Z(L)-1.D0)/R2
  490. FM(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2
  491. FM(5,L)=X(L)*Z(L)/R2
  492. FM(6,L)=Y(L)*Z(L)/R2
  493.  
  494. GM(1,1,L)=(Z(L)-1.D0)/R2
  495. GM(2,1,L)=(Z(L)-1.D0)/R2
  496. GM(3,1,L)=(X(L)+Y(L)-R2)/R2
  497. GM(1,2,L)=-(Z(L)-1.D0)/R2
  498. GM(2,2,L)=0.D0
  499. GM(3,2,L)=-X(L)/R2
  500. GM(1,3,L)=0.D0
  501. GM(2,3,L)=-(Z(L)-1.D0)/R2
  502. GM(3,3,L)=-Y(L)/R2
  503. GM(1,4,L)=-Z(L)/R2
  504. GM(2,4,L)=-Z(L)/R2
  505. GM(3,4,L)=-(X(L)+Y(L)-R2)/R2
  506. GM(1,5,L)=Z(L)/R2
  507. GM(2,5,L)=0.D0
  508. GM(3,5,L)=X(L)/R2
  509. GM(1,6,L)=0.D0
  510. GM(2,6,L)=Z(L)/R2
  511. GM(3,6,L)=Y(L)/R2
  512. C
  513. 4 CONTINUE
  514. ENDIF
  515. C write(6,*)' FM'
  516. C write(6,1002)((FM(II,JJ),II=1,MP),JJ=1,NPG)
  517.  
  518. C write(6,*)' VERIF ,PG='
  519. C write(6,1002)(pg(ii),ii=1,npg)
  520. C do 75 ll=1,npg
  521. C write(6,*)' VERIF ,fn,gr ll=',ll
  522. C write(6,1002)(fn(ii,ll),ii=1,np)
  523. C write(6,1002)(gr(1,ii,ll),ii=1,np)
  524. C write(6,1002)(gr(2,ii,ll),ii=1,np)
  525. C write(6,1002)(gr(3,ii,ll),ii=1,np)
  526. C75 continue
  527.  
  528. C write(6,*)' VERIF ,NPG,NP,NGG=',NPG,NP,NGG
  529. C UPG=0.D0
  530. C do 72 L=1,NPG
  531. C UPG=UPG+PG(L)
  532. C UF=0.D0
  533. C UG1=0.D0
  534. C UG2=0.D0
  535. C UG3=0.D0
  536. C DO 71 I=1,NP
  537. C UF=UF+FN(I,L)
  538. C UG1=UG1+GR(1,I,L)
  539. C UG2=UG2+GR(2,I,L)
  540. C UG3=UG3+GR(3,I,L)
  541. C71 CONTINUE
  542. C WRITE(6,*)' VERIF L=',L,UF,UG1,UG2,UG3
  543. C72 CONTINUE
  544.  
  545. C WRITE(6,*)' VERIF PG=',UPG
  546. C WRITE(6,101)
  547.  
  548. C IF(MP.EQ.1)THEN
  549. C DO 4 L=1,NPG
  550. C FM(1,L)=1.D0
  551. C GM(1,1,L)=0.D0
  552. C GM(2,1,L)=0.D0
  553. C GM(3,1,L)=0.D0
  554. C4 CONTINUE
  555. C ELSEIF(MP.EQ.4)THEN
  556. C XX(1)=X(L)
  557. C XX(2)=Y(L)
  558. C XX(3)=Z(L)
  559. C FM(1,L)=EQPL3P(XX,XB,XC,XD)/
  560. C & EQPL3P(XA,XB,XC,XD)
  561. C FM(2,L)=EQPL3P(XX,XA,XC,XD)/
  562. C & EQPL3P(XB,XA,XC,XD)
  563. C FM(3,L)=EQPL3P(XX,XA,XB,XD)/
  564. C & EQPL3P(XC,XA,XB,XD)
  565. C
  566. C FM(4,L)=EQPL3P(XX,XA,XB,XC)/
  567. C & EQPL3P(XD,XA,XB,XC)
  568. C CALL INITD(GM,(12*NPG),0.D0)
  569. C3 CONTINUE
  570. C ENDIF
  571.  
  572. C WRITE(6,101)
  573.  
  574. RETURN
  575. 1002 FORMAT(10(1X,1PD11.4))
  576. 1001 FORMAT(20(1X,I5))
  577. 101 FORMAT(1X,'... SUBPB663 ... FM,GM,FN,GR ',9(10H..........)/)
  578. C
  579. END
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  

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