Télécharger ktrs3.eso

Retour à la liste

Numérotation des lignes :

  1. C KTRS3 SOURCE BP208322 16/11/18 21:18:36 9177
  2. SUBROUTINE KTRS3(MACRO,MELEME,MTBT0,IRET,GA,EPS,EPSD,ALFA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC CCGEOME
  7. -INC SMCOORD
  8. -INC SMCHPOI
  9. -INC SIZFFB
  10. POINTEUR IZFF1.IZFFM,IZHR1.IZHR
  11. -INC SMELEME
  12. POINTEUR MACRO.MELEME,MFACEI.MELEME,MFICEL.MELEME,MELTFI.MELEME
  13. POINTEUR MCTREI.MELEME,MELSTB.MELEME
  14. DIMENSION XA(3,27)
  15. DIMENSION ITAB(5),GA(8),EPS(8),EPSD(8)
  16. PARAMETER (NBE=7)
  17. CHARACTER*8 LISTE(NBE),TYPE,LIST(NBE)
  18. DATA LISTE /'TRI6 ','QUA8 ','SEG3 ',
  19. & 'CU20 ','PR15 ','PY13 ','TE10 '/
  20. DATA LIST /'TRI3 ','QUA4 ','SEG2 ',
  21. & 'CUB8 ','PRI6 ','PYR5 ','TET4 '/
  22. C****
  23.  
  24. COEF=ALFA*0.01D0
  25. IAXI=0
  26. IF(IFOMOD.EQ.0)IAXI=2
  27.  
  28. IRET=1
  29. IM =0
  30.  
  31. NSOUPO=1
  32. NAT=1
  33. N=0
  34. NC=8
  35. KPOC=0
  36. SEGINI MCHPO1,MSOUP1,MPOVA1
  37. MCHPO1.JATTRI(1)=2
  38. MCHPO1.IFOPOI=IFOMOD
  39. MCHPO1.MTYPOI='CENTRE '
  40. MCHPO1.MOCHDE=' '
  41. MCHPO1.IPCHP(1)=MSOUP1
  42. MSOUP1.IPOVAL=MPOVA1
  43. MSOUP1.NOCOMP(1)='SCC1'
  44. MSOUP1.NOCOMP(2)='SCC2'
  45. MSOUP1.NOCOMP(3)='SCC3'
  46. MSOUP1.NOCOMP(4)='SCC4'
  47. MSOUP1.NOCOMP(5)='SCC5'
  48. MSOUP1.NOCOMP(6)='SCC6'
  49. MSOUP1.NOCOMP(7)='SCC7'
  50. MSOUP1.NOCOMP(8)='SCC8'
  51.  
  52. NBELEM=0
  53. NBNN=1
  54. NBSOUS=0
  55. NBREF=0
  56. SEGINI MCTREI
  57. MCTREI.ITYPEL=1
  58. KCTREI=0
  59.  
  60. C Connectivités de la matrice de stabilisation
  61. NBELEM=0
  62. NBNN=4
  63. NBSOUS=0
  64. NBREF=0
  65. SEGINI MELSTB
  66. MELSTB.ITYPEL=14
  67. KSTB=0
  68.  
  69. SEGACT MACRO
  70. NBSOUS=MACRO.LISOUS(/1)
  71. IF(NBSOUS.EQ.0)NBSOUS=1
  72. DO 1 L=1,NBSOUS
  73. IPT1=MACRO
  74. IF(NBSOUS.NE.1)IPT1=MACRO.LISOUS(L)
  75. SEGACT IPT1
  76. TYPE=NOMS(IPT1.ITYPEL)//' '
  77. CALL OPTLI(IP,LISTE,TYPE,NBE)
  78. IF(IP.EQ.0)THEN
  79. WRITE(6,*)' Type d''élément : ',TYPE,' non prévu '
  80. IRET=0
  81. RETURN
  82. ENDIF
  83. GO TO (106,108,103,120,115,113,110),IP
  84.  
  85. C TRI6 -> 4 TRI3
  86. 106 CONTINUE
  87. NBEL=IPT1.NUM(/2)
  88. NP=IPT1.NUM(/1)
  89. NBPC=NBEL*4
  90. KCTREI=1
  91. C write(6,*)' TRI6 -> 4 TRI3 nbel= ',nbel
  92.  
  93. NBV0=XCOOR(/1)/(IDIM+1)
  94. NBPTS=NBV0+NBPC
  95. SEGADJ MCOORD
  96.  
  97. C maillage de lineaires
  98. NBELEM=4*NBEL
  99. NBNN=3
  100. NBSOUS=0
  101. NBREF=0
  102. SEGINI IPT2
  103. IPT2.ITYPEL=4
  104. IM=IM+1
  105. ITAB(IM)=IPT2
  106.  
  107. K1=0
  108. DO 206 K=1,NBEL
  109. N1=IPT1.NUM(1,K)
  110. N2=IPT1.NUM(2,K)
  111. N3=IPT1.NUM(3,K)
  112. N4=IPT1.NUM(4,K)
  113. N5=IPT1.NUM(5,K)
  114. N6=IPT1.NUM(6,K)
  115.  
  116. DO 1061 M=1,3
  117. XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M)
  118. XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M)
  119. XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M)
  120. XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M)
  121. XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M)
  122. XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M)
  123. 1061 CONTINUE
  124.  
  125. CT1
  126. K1=K1+1
  127. NC1=NBV0+K1
  128.  
  129. IPT2.NUM(1,K1)=N1
  130. IPT2.NUM(2,K1)=N2
  131. IPT2.NUM(3,K1)=N6
  132.  
  133. CT2
  134. K1=K1+1
  135. NC2=NBV0+K1
  136.  
  137. IPT2.NUM(1,K1)=N3
  138. IPT2.NUM(2,K1)=N4
  139. IPT2.NUM(3,K1)=N2
  140.  
  141. CT3
  142. K1=K1+1
  143. NC3=NBV0+K1
  144.  
  145. IPT2.NUM(1,K1)=N5
  146. IPT2.NUM(2,K1)=N6
  147. IPT2.NUM(3,K1)=N4
  148.  
  149. CT4
  150. K1=K1+1
  151. NC4=NBV0+K1
  152.  
  153. IPT2.NUM(1,K1)=N2
  154. IPT2.NUM(2,K1)=N4
  155. IPT2.NUM(3,K1)=N6
  156.  
  157. DO 1062 M=1,3
  158. XCOOR((NC4-1)*(IDIM+1) +M)= (XA(M,2)+XA(M,4)+XA(M,6))/3.D0
  159. XCOOR((NC1-1)*(IDIM+1) +M)= (XA(M,1)+XA(M,2)+XA(M,6))/3.D0
  160. XCOOR((NC2-1)*(IDIM+1) +M)= (XA(M,3)+XA(M,4)+XA(M,2))/3.D0
  161. XCOOR((NC3-1)*(IDIM+1) +M)= (XA(M,5)+XA(M,6)+XA(M,4))/3.D0
  162. 1062 CONTINUE
  163.  
  164. 206 CONTINUE
  165. SEGDES IPT1,IPT2
  166. GO TO 1
  167.  
  168. C**************************************************************************
  169.  
  170. C QUA8 -> 4 QUA4
  171. 108 CONTINUE
  172.  
  173. NBEL=IPT1.NUM(/2)
  174. NP=IPT1.NUM(/1)
  175. NBP9=NBEL
  176. NBPC=NBEL*4
  177. KCTREI=1
  178. C write(6,*)' QUA8 -> 4 QUA4 nbel=',nbel
  179.  
  180. NBV0=XCOOR(/1)/(IDIM+1)
  181. NBPTS=NBV0+NBPC+NBP9
  182. SEGADJ MCOORD
  183.  
  184. C maillage de lineaires
  185. NBELEM=4*NBEL
  186. NBNN=4
  187. NBSOUS=0
  188. NBREF=0
  189. SEGINI IPT2
  190. IPT2.ITYPEL=8
  191. IM=IM+1
  192. ITAB(IM)=IPT2
  193.  
  194. K1=0
  195. DO 208 K=1,NBEL
  196. N1=IPT1.NUM(1,K)
  197. N2=IPT1.NUM(2,K)
  198. N3=IPT1.NUM(3,K)
  199. N4=IPT1.NUM(4,K)
  200. N5=IPT1.NUM(5,K)
  201. N6=IPT1.NUM(6,K)
  202. N7=IPT1.NUM(7,K)
  203. N8=IPT1.NUM(8,K)
  204. N9=NBV0+NBPC+K
  205. C write(6,*)' N1,N2,N3,N4,N5,N6,N7,N8,N9=',
  206. C &N1,N2,N3,N4,N5,N6,N7,N8,N9
  207.  
  208. DO 1081 M=1,3
  209. XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M)
  210. XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M)
  211. XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M)
  212. XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M)
  213. XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M)
  214. XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M)
  215. XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M)
  216. XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M)
  217. 1081 CONTINUE
  218.  
  219. CALL FFQUA8(XA)
  220.  
  221.  
  222. CQ1
  223. K1=K1+1
  224. NC1=NBV0+K1
  225.  
  226. IPT2.NUM(1,K1)=N1
  227. IPT2.NUM(2,K1)=N2
  228. IPT2.NUM(3,K1)=N9
  229. IPT2.NUM(4,K1)=N8
  230. CQ2
  231. K1=K1+1
  232. NC2=NBV0+K1
  233.  
  234. IPT2.NUM(1,K1)=N3
  235. IPT2.NUM(2,K1)=N4
  236. IPT2.NUM(3,K1)=N9
  237. IPT2.NUM(4,K1)=N2
  238. CQ3
  239. K1=K1+1
  240. NC3=NBV0+K1
  241.  
  242. IPT2.NUM(1,K1)=N5
  243. IPT2.NUM(2,K1)=N6
  244. IPT2.NUM(3,K1)=N9
  245. IPT2.NUM(4,K1)=N4
  246. CQ4
  247. K1=K1+1
  248. NC4=NBV0+K1
  249.  
  250. IPT2.NUM(1,K1)=N7
  251. IPT2.NUM(2,K1)=N8
  252. IPT2.NUM(3,K1)=N9
  253. IPT2.NUM(4,K1)=N6
  254.  
  255. DO 1082 M=1,3
  256. XCOOR((N9-1)*(IDIM+1) +M)=XA(M,9)
  257. XCOOR((NC1-1)*(IDIM+1) +M)= (XA(M,1)+XA(M,2)+XA(M,9)+XA(M,8))/4.D0
  258. XCOOR((NC2-1)*(IDIM+1) +M)= (XA(M,3)+XA(M,4)+XA(M,9)+XA(M,2))/4.D0
  259. XCOOR((NC3-1)*(IDIM+1) +M)= (XA(M,5)+XA(M,6)+XA(M,9)+XA(M,4))/4.D0
  260. XCOOR((NC4-1)*(IDIM+1) +M)= (XA(M,7)+XA(M,8)+XA(M,9)+XA(M,6))/4.D0
  261.  
  262. 1082 CONTINUE
  263.  
  264. 208 CONTINUE
  265. SEGDES IPT1,IPT2
  266. GO TO 1
  267.  
  268. C**************************************************************************
  269.  
  270. C SEG3 -> 2 SEG2
  271. 103 CONTINUE
  272. NBEL=IPT1.NUM(/2)
  273. NP=IPT1.NUM(/1)
  274.  
  275. NBELEM=2*NBEL
  276. write(6,*)' SEG3 -> 2 SEG2 nbel=',nbel
  277. NBNN=2
  278. NBSOUS=0
  279. NBREF=0
  280. SEGINI IPT2
  281. IPT2.ITYPEL=2
  282. IM=IM+1
  283. ITAB(IM)=IPT2
  284.  
  285. K1=0
  286. DO 203 K=1,NBEL
  287. N1=IPT1.NUM(1,K)
  288. N2=IPT1.NUM(2,K)
  289. N3=IPT1.NUM(3,K)
  290.  
  291. CS1
  292. K1=K1+1
  293.  
  294. IPT2.NUM(1,K1)=N1
  295. IPT2.NUM(2,K1)=N2
  296.  
  297. CS2
  298. K1=K1+1
  299.  
  300. IPT2.NUM(1,K1)=N2
  301. IPT2.NUM(2,K1)=N3
  302. 203 CONTINUE
  303. SEGDES IPT1,IPT2
  304. GO TO 1
  305. C**************************************************************************
  306. C CU20 -> 8 CUB8
  307. 120 CONTINUE
  308. C write(6,*)' CU20 -> 8 CUB8 '
  309. NBEL=IPT1.NUM(/2)
  310. NP=IPT1.NUM(/1)
  311. NBPC=NBEL*8
  312. NBP9=NBEL*7
  313.  
  314. N=NBPC+MPOVA1.VPOCHA(/1)
  315. NC=8
  316. NCTV0=MPOVA1.VPOCHA(/1)
  317. SEGADJ MPOVA1
  318.  
  319. NBV0=XCOOR(/1)/(IDIM+1)
  320. NBPTS=NBV0+NBPC+NBP9
  321. SEGADJ MCOORD
  322.  
  323. C maillage de lineaires
  324. NBELEM=8*NBEL
  325. NBNN=8
  326. NBSOUS=0
  327. NBREF=0
  328. SEGINI IPT2
  329. IPT2.ITYPEL=14
  330. IM=IM+1
  331. ITAB(IM)=IPT2
  332.  
  333. C Spg des pts centres des macro elements
  334. NCTR0=MCTREI.NUM(/2)
  335. NBELEM=NCTR0+NBPC
  336. NBNN=1
  337. NBSOUS=0
  338. NBREF=0
  339. SEGADJ MCTREI
  340. KCTREI=1
  341.  
  342. C Connectivités de la matrice de stabilisation
  343. NCSTB=MELSTB.NUM(/2)
  344. NBELEM=NCSTB+NBPC
  345. NBNN=8
  346. C write(6,*)' KTRS3 : ',nbnn,nbelem
  347. NBSOUS=0
  348. NBREF=0
  349. SEGADJ MELSTB
  350. KSTB=1
  351.  
  352. CALL KALPBG('QUA4 ','FONFORM0',IZFFM)
  353. IF(IZFFM.EQ.0)CALL ARRET(0)
  354. SEGACT IZFFM*MOD
  355. IZHR=KZHR(1)
  356. SEGACT IZHR*MOD
  357. NPG=GR(/3)
  358. NES=GR(/1)
  359. NPI=4
  360.  
  361. K1=0
  362. DO 220 K=1,NBEL
  363. N1=IPT1.NUM(1,K)
  364. N2=IPT1.NUM(2,K)
  365. N3=IPT1.NUM(3,K)
  366. N4=IPT1.NUM(4,K)
  367. N5=IPT1.NUM(5,K)
  368. N6=IPT1.NUM(6,K)
  369. N7=IPT1.NUM(7,K)
  370. N8=IPT1.NUM(8,K)
  371. N9=IPT1.NUM(9,K)
  372. N10=IPT1.NUM(10,K)
  373. N11=IPT1.NUM(11,K)
  374. N12=IPT1.NUM(12,K)
  375. N13=IPT1.NUM(13,K)
  376. N14=IPT1.NUM(14,K)
  377. N15=IPT1.NUM(15,K)
  378. N16=IPT1.NUM(16,K)
  379. N17=IPT1.NUM(17,K)
  380. N18=IPT1.NUM(18,K)
  381. N19=IPT1.NUM(19,K)
  382. N20=IPT1.NUM(20,K)
  383. N21=NBV0+NBPC+(K-1)*7+1
  384. N22=NBV0+NBPC+(K-1)*7+2
  385. N23=NBV0+NBPC+(K-1)*7+3
  386. N24=NBV0+NBPC+(K-1)*7+4
  387. N25=NBV0+NBPC+(K-1)*7+5
  388. N26=NBV0+NBPC+(K-1)*7+6
  389. N27=NBV0+NBPC+(K-1)*7+7
  390. NC1=NBV0+(K-1)*8+1
  391. NC2=NBV0+(K-1)*8+2
  392. NC3=NBV0+(K-1)*8+3
  393. NC4=NBV0+(K-1)*8+4
  394. NC5=NBV0+(K-1)*8+5
  395. NC6=NBV0+(K-1)*8+6
  396. NC7=NBV0+(K-1)*8+7
  397. NC8=NBV0+(K-1)*8+8
  398.  
  399. DO 2201 M=1,3
  400. XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M)
  401. XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M)
  402. XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M)
  403. XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M)
  404. XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M)
  405. XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M)
  406. XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M)
  407. XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M)
  408. XA(M,9)=XCOOR((N9-1)*(IDIM+1) +M)
  409. XA(M,10)=XCOOR((N10-1)*(IDIM+1) +M)
  410. XA(M,11)=XCOOR((N11-1)*(IDIM+1) +M)
  411. XA(M,12)=XCOOR((N12-1)*(IDIM+1) +M)
  412. XA(M,13)=XCOOR((N13-1)*(IDIM+1) +M)
  413. XA(M,14)=XCOOR((N14-1)*(IDIM+1) +M)
  414. XA(M,15)=XCOOR((N15-1)*(IDIM+1) +M)
  415. XA(M,16)=XCOOR((N16-1)*(IDIM+1) +M)
  416. XA(M,17)=XCOOR((N17-1)*(IDIM+1) +M)
  417. XA(M,18)=XCOOR((N18-1)*(IDIM+1) +M)
  418. XA(M,19)=XCOOR((N19-1)*(IDIM+1) +M)
  419. XA(M,20)=XCOOR((N20-1)*(IDIM+1) +M)
  420. 2201 CONTINUE
  421.  
  422. CALL FFCU20(XA)
  423.  
  424.  
  425. DO 2202 M=1,3
  426.  
  427. XCOOR((N21-1)*(IDIM+1) +M)=XA(M,21)
  428. XCOOR((N22-1)*(IDIM+1) +M)=XA(M,22)
  429. XCOOR((N23-1)*(IDIM+1) +M)=XA(M,23)
  430. XCOOR((N24-1)*(IDIM+1) +M)=XA(M,24)
  431. XCOOR((N25-1)*(IDIM+1) +M)=XA(M,25)
  432. XCOOR((N26-1)*(IDIM+1) +M)=XA(M,26)
  433. XCOOR((N27-1)*(IDIM+1) +M)=XA(M,27)
  434.  
  435. XNC1 =(XA(M,1)+XA(M,2)+XA(M,21)+XA(M,8)+XA(M,9)+XA(M,23)
  436. & +XA(M,27)+XA(M,26))/8.D0
  437. XCOOR((NC1 -1)*(IDIM+1) +M)=XNC1
  438.  
  439. XNC2 =(XA(M,3)+XA(M,2)+XA(M,21)+XA(M,4)+XA(M,10)+XA(M,23)
  440. & +XA(M,27)+XA(M,24))/8.D0
  441. XCOOR((NC2 -1)*(IDIM+1) +M)=XNC2
  442.  
  443. XNC3 =(XA(M,5)+XA(M,6)+XA(M,21)+XA(M,4)+XA(M,25)
  444. & +XA(M,11)+XA(M,27)+XA(M,24))/8.D0
  445. XCOOR((NC3 -1)*(IDIM+1) +M)=XNC3
  446.  
  447. XNC4 =(XA(M,8)+XA(M,6)+XA(M,21)+XA(M,7)+XA(M,25)
  448. & +XA(M,12)+XA(M,27)+XA(M,26))/8.D0
  449. XCOOR((NC4 -1)*(IDIM+1) +M)=XNC4
  450.  
  451. XNC5 =(XA(M,26)+XA(M,9)+XA(M,23)+XA(M,27)+XA(M,20)
  452. & +XA(M,13)+XA(M,14)+XA(M,22))/8.D0
  453. XCOOR((NC5 -1)*(IDIM+1) +M)=XNC5
  454.  
  455. XNC6 =(XA(M,10)+XA(M,24)+XA(M,23)+XA(M,27)+XA(M,22)
  456. & +XA(M,15)+XA(M,14)+XA(M,16))/8.D0
  457. XCOOR((NC6 -1)*(IDIM+1) +M)=XNC6
  458.  
  459. XNC7 =(XA(M,11)+XA(M,24)+XA(M,25)+XA(M,27)+XA(M,22)
  460. & +XA(M,17)+XA(M,18)+XA(M,16))/8.D0
  461. XCOOR((NC7 -1)*(IDIM+1) +M)=XNC7
  462.  
  463. XNC8 =(XA(M,12)+XA(M,26)+XA(M,25)+XA(M,27)+XA(M,22)
  464. & +XA(M,20)+XA(M,18)+XA(M,19))/8.D0
  465. XCOOR((NC8 -1)*(IDIM+1) +M)=XNC8
  466.  
  467. 2202 CONTINUE
  468.  
  469. MCTREI.NUM(1,NCTR0+K1+1)=NC1
  470. MCTREI.NUM(1,NCTR0+K1+2)=NC2
  471. MCTREI.NUM(1,NCTR0+K1+3)=NC3
  472. MCTREI.NUM(1,NCTR0+K1+4)=NC4
  473. MCTREI.NUM(1,NCTR0+K1+5)=NC5
  474. MCTREI.NUM(1,NCTR0+K1+6)=NC6
  475. MCTREI.NUM(1,NCTR0+K1+7)=NC7
  476. MCTREI.NUM(1,NCTR0+K1+8)=NC8
  477.  
  478. IPT2.NUM(1,K1+1)=N1
  479. IPT2.NUM(2,K1+1)=N2
  480. IPT2.NUM(3,K1+1)=N21
  481. IPT2.NUM(4,K1+1)=N8
  482. IPT2.NUM(5,K1+1)=N9
  483. IPT2.NUM(6,K1+1)=N23
  484. IPT2.NUM(7,K1+1)=N27
  485. IPT2.NUM(8,K1+1)=N26
  486.  
  487. IPT2.NUM(1,K1+2)=N2
  488. IPT2.NUM(2,K1+2)=N3
  489. IPT2.NUM(3,K1+2)=N4
  490. IPT2.NUM(4,K1+2)=N21
  491. IPT2.NUM(5,K1+2)=N23
  492. IPT2.NUM(6,K1+2)=N10
  493. IPT2.NUM(7,K1+2)=N24
  494. IPT2.NUM(8,K1+2)=N27
  495.  
  496. IPT2.NUM(1,K1+3)=N4
  497. IPT2.NUM(2,K1+3)=N5
  498. IPT2.NUM(3,K1+3)=N6
  499. IPT2.NUM(4,K1+3)=N21
  500. IPT2.NUM(5,K1+3)=N24
  501. IPT2.NUM(6,K1+3)=N11
  502. IPT2.NUM(7,K1+3)=N25
  503. IPT2.NUM(8,K1+3)=N27
  504.  
  505. IPT2.NUM(1,K1+4)=N8
  506. IPT2.NUM(2,K1+4)=N21
  507. IPT2.NUM(3,K1+4)=N6
  508. IPT2.NUM(4,K1+4)=N7
  509. IPT2.NUM(5,K1+4)=N26
  510. IPT2.NUM(6,K1+4)=N27
  511. IPT2.NUM(7,K1+4)=N25
  512. IPT2.NUM(8,K1+4)=N12
  513.  
  514. IPT2.NUM(1,K1+5)=N9
  515. IPT2.NUM(2,K1+5)=N23
  516. IPT2.NUM(3,K1+5)=N27
  517. IPT2.NUM(4,K1+5)=N26
  518. IPT2.NUM(5,K1+5)=N13
  519. IPT2.NUM(6,K1+5)=N14
  520. IPT2.NUM(7,K1+5)=N22
  521. IPT2.NUM(8,K1+5)=N20
  522.  
  523. IPT2.NUM(1,K1+6)=N23
  524. IPT2.NUM(2,K1+6)=N10
  525. IPT2.NUM(3,K1+6)=N24
  526. IPT2.NUM(4,K1+6)=N27
  527. IPT2.NUM(5,K1+6)=N14
  528. IPT2.NUM(6,K1+6)=N15
  529. IPT2.NUM(7,K1+6)=N16
  530. IPT2.NUM(8,K1+6)=N22
  531.  
  532. IPT2.NUM(1,K1+7)=N25
  533. IPT2.NUM(2,K1+7)=N27
  534. IPT2.NUM(3,K1+7)=N24
  535. IPT2.NUM(4,K1+7)=N11
  536. IPT2.NUM(5,K1+7)=N18
  537. IPT2.NUM(6,K1+7)=N22
  538. IPT2.NUM(7,K1+7)=N16
  539. IPT2.NUM(8,K1+7)=N17
  540.  
  541. IPT2.NUM(1,K1+8)=N26
  542. IPT2.NUM(2,K1+8)=N27
  543. IPT2.NUM(3,K1+8)=N25
  544. IPT2.NUM(4,K1+8)=N12
  545. IPT2.NUM(5,K1+8)=N20
  546. IPT2.NUM(6,K1+8)=N22
  547. IPT2.NUM(7,K1+8)=N18
  548. IPT2.NUM(8,K1+8)=N19
  549.  
  550. K1=K1+8
  551.  
  552. C DF1
  553. DO 22001 M=1,3
  554. XYZ(M,1)=XA(M,2)
  555. XYZ(M,2)=XA(M,21)
  556. XYZ(M,3)=XA(M,27)
  557. XYZ(M,4)=XA(M,23)
  558. 22001 CONTINUE
  559.  
  560. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)
  561.  
  562. AIR1=ABS(AIR1)
  563. DF1=SQRT(AIR1)
  564.  
  565. CDF2
  566. DO 22002 M=1,3
  567. XYZ(M,1)=XA(M,21)
  568. XYZ(M,2)=XA(M,4)
  569. XYZ(M,3)=XA(M,24)
  570. XYZ(M,4)=XA(M,27)
  571. 22002 CONTINUE
  572.  
  573. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)
  574.  
  575. AIR2=ABS(AIR2)
  576. DF2=SQRT(AIR2)
  577.  
  578. CDF3
  579. DO 22003 M=1,3
  580. XYZ(M,1)=XA(M,21)
  581. XYZ(M,2)=XA(M,6)
  582. XYZ(M,3)=XA(M,25)
  583. XYZ(M,4)=XA(M,27)
  584. 22003 CONTINUE
  585.  
  586. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)
  587.  
  588. AIR3=ABS(AIR3)
  589. DF3=SQRT(AIR3)
  590.  
  591. CDF4
  592. DO 22004 M=1,3
  593. XYZ(M,1)=XA(M,21)
  594. XYZ(M,2)=XA(M,8)
  595. XYZ(M,3)=XA(M,26)
  596. XYZ(M,4)=XA(M,27)
  597. 22004 CONTINUE
  598.  
  599. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4)
  600.  
  601. AIR4=ABS(AIR4)
  602. DF4=SQRT(AIR4)
  603.  
  604. CDF5
  605. DO 22005 M=1,3
  606. XYZ(M,1)=XA(M,9 )
  607. XYZ(M,2)=XA(M,23)
  608. XYZ(M,3)=XA(M,27)
  609. XYZ(M,4)=XA(M,26)
  610. 22005 CONTINUE
  611.  
  612. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR5)
  613.  
  614. AIR5=ABS(AIR5)
  615. DF5=SQRT(AIR5)
  616.  
  617. CDF6
  618. DO 22006 M=1,3
  619. XYZ(M,1)=XA(M,10)
  620. XYZ(M,2)=XA(M,24)
  621. XYZ(M,3)=XA(M,27)
  622. XYZ(M,4)=XA(M,23)
  623. 22006 CONTINUE
  624.  
  625. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR6)
  626.  
  627. AIR6=ABS(AIR6)
  628. DF6=SQRT(AIR6)
  629.  
  630. CDF7
  631. DO 22007 M=1,3
  632. XYZ(M,1)=XA(M,11)
  633. XYZ(M,2)=XA(M,25)
  634. XYZ(M,3)=XA(M,27)
  635. XYZ(M,4)=XA(M,24)
  636. 22007 CONTINUE
  637.  
  638. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR7)
  639.  
  640. AIR7=ABS(AIR7)
  641. DF7=SQRT(AIR7)
  642.  
  643. CDF8
  644. DO 22008 M=1,3
  645. XYZ(M,1)=XA(M,12)
  646. XYZ(M,2)=XA(M,26)
  647. XYZ(M,3)=XA(M,27)
  648. XYZ(M,4)=XA(M,25)
  649. 22008 CONTINUE
  650.  
  651. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8)
  652.  
  653. AIR8=ABS(AIR8)
  654. DF8=SQRT(AIR8)
  655.  
  656. CDF9
  657. DO 22009 M=1,3
  658. XYZ(M,1)=XA(M,23)
  659. XYZ(M,2)=XA(M,27)
  660. XYZ(M,3)=XA(M,22)
  661. XYZ(M,4)=XA(M,14)
  662. 22009 CONTINUE
  663.  
  664. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR9)
  665.  
  666. AIR9=ABS(AIR9)
  667. DF9=SQRT(AIR9)
  668.  
  669. CDF10
  670. DO 22010 M=1,3
  671. XYZ(M,1)=XA(M,16)
  672. XYZ(M,2)=XA(M,24)
  673. XYZ(M,3)=XA(M,27)
  674. XYZ(M,4)=XA(M,22)
  675. 22010 CONTINUE
  676.  
  677. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR10)
  678.  
  679. AIR10=ABS(AIR10)
  680. DF10=SQRT(AIR10)
  681.  
  682. CDF11
  683. DO 22011 M=1,3
  684. XYZ(M,1)=XA(M,18)
  685. XYZ(M,2)=XA(M,25)
  686. XYZ(M,3)=XA(M,27)
  687. XYZ(M,4)=XA(M,22)
  688. 22011 CONTINUE
  689.  
  690. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR11)
  691.  
  692. AIR11=ABS(AIR11)
  693. DF11=SQRT(AIR11)
  694.  
  695. CDF12
  696. DO 22012 M=1,3
  697. XYZ(M,1)=XA(M,20)
  698. XYZ(M,2)=XA(M,26)
  699. XYZ(M,3)=XA(M,27)
  700. XYZ(M,4)=XA(M,22)
  701. 22012 CONTINUE
  702.  
  703. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR12)
  704.  
  705. AIR12=ABS(AIR12)
  706. DF12=SQRT(AIR12)
  707.  
  708. DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8+DF9+DF10+DF11+DF12)/12.D0
  709. AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6
  710. & +AIR7+AIR8+AIR9+AIR10+AIR11+AIR12)/12.D0
  711.  
  712. MELSTB.NUM(1,NCSTB+K)=NC1
  713. MELSTB.NUM(2,NCSTB+K)=NC2
  714. MELSTB.NUM(3,NCSTB+K)=NC3
  715. MELSTB.NUM(4,NCSTB+K)=NC4
  716. MELSTB.NUM(5,NCSTB+K)=NC5
  717. MELSTB.NUM(6,NCSTB+K)=NC6
  718. MELSTB.NUM(7,NCSTB+K)=NC7
  719. MELSTB.NUM(8,NCSTB+K)=NC8
  720.  
  721. MELSTB.NUM(1,NCSTB+K+1)=NC2
  722. MELSTB.NUM(2,NCSTB+K+1)=NC3
  723. MELSTB.NUM(3,NCSTB+K+1)=NC4
  724. MELSTB.NUM(4,NCSTB+K+1)=NC5
  725. MELSTB.NUM(5,NCSTB+K+1)=NC6
  726. MELSTB.NUM(6,NCSTB+K+1)=NC7
  727. MELSTB.NUM(7,NCSTB+K+1)=NC8
  728. MELSTB.NUM(8,NCSTB+K+1)=NC1
  729.  
  730. MELSTB.NUM(1,NCSTB+K+2)=NC3
  731. MELSTB.NUM(2,NCSTB+K+2)=NC4
  732. MELSTB.NUM(3,NCSTB+K+2)=NC5
  733. MELSTB.NUM(4,NCSTB+K+2)=NC6
  734. MELSTB.NUM(5,NCSTB+K+2)=NC7
  735. MELSTB.NUM(6,NCSTB+K+2)=NC8
  736. MELSTB.NUM(7,NCSTB+K+2)=NC1
  737. MELSTB.NUM(8,NCSTB+K+2)=NC2
  738.  
  739. MELSTB.NUM(1,NCSTB+K+3)=NC4
  740. MELSTB.NUM(2,NCSTB+K+3)=NC5
  741. MELSTB.NUM(3,NCSTB+K+3)=NC6
  742. MELSTB.NUM(4,NCSTB+K+3)=NC7
  743. MELSTB.NUM(5,NCSTB+K+3)=NC8
  744. MELSTB.NUM(6,NCSTB+K+3)=NC1
  745. MELSTB.NUM(7,NCSTB+K+3)=NC2
  746. MELSTB.NUM(8,NCSTB+K+3)=NC3
  747.  
  748. MELSTB.NUM(1,NCSTB+K+4)=NC5
  749. MELSTB.NUM(2,NCSTB+K+4)=NC6
  750. MELSTB.NUM(3,NCSTB+K+4)=NC7
  751. MELSTB.NUM(4,NCSTB+K+4)=NC8
  752. MELSTB.NUM(5,NCSTB+K+4)=NC1
  753. MELSTB.NUM(6,NCSTB+K+4)=NC2
  754. MELSTB.NUM(7,NCSTB+K+4)=NC3
  755. MELSTB.NUM(8,NCSTB+K+4)=NC4
  756.  
  757. MELSTB.NUM(1,NCSTB+K+5)=NC6
  758. MELSTB.NUM(2,NCSTB+K+5)=NC7
  759. MELSTB.NUM(3,NCSTB+K+5)=NC8
  760. MELSTB.NUM(4,NCSTB+K+5)=NC1
  761. MELSTB.NUM(5,NCSTB+K+5)=NC2
  762. MELSTB.NUM(6,NCSTB+K+5)=NC3
  763. MELSTB.NUM(7,NCSTB+K+5)=NC4
  764. MELSTB.NUM(8,NCSTB+K+5)=NC5
  765.  
  766. MELSTB.NUM(1,NCSTB+K+6)=NC7
  767. MELSTB.NUM(2,NCSTB+K+6)=NC8
  768. MELSTB.NUM(3,NCSTB+K+6)=NC1
  769. MELSTB.NUM(4,NCSTB+K+6)=NC2
  770. MELSTB.NUM(5,NCSTB+K+6)=NC3
  771. MELSTB.NUM(6,NCSTB+K+6)=NC4
  772. MELSTB.NUM(7,NCSTB+K+6)=NC5
  773. MELSTB.NUM(8,NCSTB+K+6)=NC6
  774.  
  775. MELSTB.NUM(1,NCSTB+K+7)=NC8
  776. MELSTB.NUM(2,NCSTB+K+7)=NC1
  777. MELSTB.NUM(3,NCSTB+K+7)=NC2
  778. MELSTB.NUM(4,NCSTB+K+7)=NC3
  779. MELSTB.NUM(5,NCSTB+K+7)=NC4
  780. MELSTB.NUM(6,NCSTB+K+7)=NC5
  781. MELSTB.NUM(7,NCSTB+K+7)=NC6
  782. MELSTB.NUM(8,NCSTB+K+7)=NC7
  783.  
  784.  
  785.  
  786. H12=AIR1*DF1*GA(4)
  787. H13=AIRM*DFM*EPS(4)
  788. H14=AIR4*DF4*GA(4)
  789. H15=AIR5*DF5*GA(4)
  790. H16=AIRM*DFM*EPS(4)
  791. H17=AIRM*DFM*EPS(4)
  792. H18=AIRM*DFM*EPS(4)
  793.  
  794. H23=AIR2*DF2*GA(4)
  795. H24=AIRM*DFM*EPS(4)
  796. H25=AIRM*DFM*EPS(4)
  797. H26=AIR6*DF6*GA(4)
  798. H27=AIRM*DFM*EPS(4)
  799. H28=AIRM*DFM*EPS(4)
  800.  
  801. H34=AIR3*DF3*GA(4)
  802. H35=AIRM*DFM*EPS(4)
  803. H36=AIRM*DFM*EPS(4)
  804. H37=AIR7*DF7*GA(4)
  805. H38=AIRM*DFM*EPS(4)
  806.  
  807. H45=AIRM*DFM*EPS(4)
  808. H46=AIRM*DFM*EPS(4)
  809. H47=AIRM*DFM*EPS(4)
  810. H48=AIR8*DF8*GA(4)
  811.  
  812. H56=AIR9*DF9*GA(4)
  813. H57=AIRM*DFM*EPS(4)
  814. H58=AIR12*DF12*GA(4)
  815.  
  816. H67=AIR10*DF10*GA(4)
  817. H68=AIRM*DFM*EPS(4)
  818.  
  819. H78=AIR11*DF11*GA(4)
  820.  
  821. MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18
  822. MPOVA1.VPOCHA(NCTV0+K,2)=-H12
  823. MPOVA1.VPOCHA(NCTV0+K,3)=-H13
  824. MPOVA1.VPOCHA(NCTV0+K,4)=-H14
  825. MPOVA1.VPOCHA(NCTV0+K,5)=-H15
  826. MPOVA1.VPOCHA(NCTV0+K,6)=-H16
  827. MPOVA1.VPOCHA(NCTV0+K,7)=-H17
  828. MPOVA1.VPOCHA(NCTV0+K,8)=-H18
  829. MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28
  830. MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
  831. MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
  832. MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25
  833. MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26
  834. MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27
  835. MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28
  836. MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12
  837. MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38
  838. MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
  839. MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35
  840. MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36
  841. MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37
  842. MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38
  843. MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13
  844. MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23
  845. MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48
  846. MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45
  847. MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46
  848. MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47
  849. MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48
  850. MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14
  851. MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24
  852. MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34
  853. MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58
  854. MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56
  855. MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57
  856. MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58
  857. MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15
  858. MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25
  859. MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35
  860. MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45
  861. MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68
  862. MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67
  863. MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68
  864. MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16
  865. MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26
  866. MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36
  867. MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46
  868. MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56
  869. MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78
  870. MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78
  871. MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17
  872. MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27
  873. MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37
  874. MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47
  875. MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57
  876. MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67
  877. MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78
  878. MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18
  879. MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28
  880. MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38
  881. MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48
  882. MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58
  883. MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68
  884. MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78
  885. KPOC=1
  886. NCTV0=NCTV0+7
  887. NCSTB=NCSTB+7
  888.  
  889.  
  890.  
  891. 220 CONTINUE
  892. C SEGDES IPT1,IPT2,IPT3
  893. SEGDES IPT1,IPT2
  894. GO TO 1
  895.  
  896. C**************************************************************************
  897. C PR15 -> 8 PRI6
  898.  
  899. 115 CONTINUE
  900. C write(6,*)' PR15 -> 8 PRI6 '
  901. NBEL=IPT1.NUM(/2)
  902. NP=IPT1.NUM(/1)
  903. NBPC=NBEL*8
  904. NBP9=NBEL*3
  905.  
  906. N=NBPC+MPOVA1.VPOCHA(/1)
  907. NC=8
  908. NCTV0=MPOVA1.VPOCHA(/1)
  909. SEGADJ MPOVA1
  910.  
  911. NBV0=XCOOR(/1)/(IDIM+1)
  912. NBPTS=NBV0+NBPC+NBP9
  913. SEGADJ MCOORD
  914.  
  915. C maillage de lineaires
  916. NBELEM=8*NBEL
  917. NBNN=6
  918. NBSOUS=0
  919. NBREF=0
  920. SEGINI IPT2
  921. IPT2.ITYPEL=16
  922. IM=IM+1
  923. ITAB(IM)=IPT2
  924.  
  925. C Spg des pts centres des macro elements
  926. NCTR0=MCTREI.NUM(/2)
  927. NBELEM=NCTR0+NBPC
  928. NBNN=1
  929. NBSOUS=0
  930. NBREF=0
  931. SEGADJ MCTREI
  932. KCTREI=1
  933.  
  934. C Connectivités de la matrice de stabilisation
  935. NCSTB=MELSTB.NUM(/2)
  936. NBELEM=NCSTB+NBPC
  937. NBNN=8
  938. C write(6,*)' KTRS3 : ',nbnn,nbelem
  939. NBSOUS=0
  940. NBREF=0
  941. SEGADJ MELSTB
  942. KSTB=1
  943.  
  944. CALL KALPBG('QUA4 ','FONFORM0',IZFFM)
  945. IF(IZFFM.EQ.0)CALL ARRET(0)
  946. SEGACT IZFFM*MOD
  947. IZHR=KZHR(1)
  948. SEGACT IZHR*MOD
  949. NPG=GR(/3)
  950. NES=GR(/1)
  951.  
  952. CALL KALPBG('TRI3 ','FONFORM0',IZFF1)
  953. IF(IZFF1.EQ.0)CALL ARRET(0)
  954. SEGACT IZFF1*MOD
  955. IZHR1=IZFF1.KZHR(1)
  956. SEGACT IZHR1*MOD
  957. NPG1=IZFF1.GR(/3)
  958. NES1=IZFF1.GR(/1)
  959.  
  960. NPI=4
  961. NPI1=3
  962. C write(6,*)' npg1,nes1,npi1=',npg1,nes1,npi1
  963.  
  964. K1=0
  965. DO 215 K=1,NBEL
  966. N1=IPT1.NUM(1,K)
  967. N2=IPT1.NUM(2,K)
  968. N3=IPT1.NUM(3,K)
  969. N4=IPT1.NUM(4,K)
  970. N5=IPT1.NUM(5,K)
  971. N6=IPT1.NUM(6,K)
  972. N7=IPT1.NUM(7,K)
  973. N8=IPT1.NUM(8,K)
  974. N9=IPT1.NUM(9,K)
  975. N10=IPT1.NUM(10,K)
  976. N11=IPT1.NUM(11,K)
  977. N12=IPT1.NUM(12,K)
  978. N13=IPT1.NUM(13,K)
  979. N14=IPT1.NUM(14,K)
  980. N15=IPT1.NUM(15,K)
  981. N16=NBV0+NBPC+(K-1)*3+1
  982. N17=NBV0+NBPC+(K-1)*3+2
  983. N18=NBV0+NBPC+(K-1)*3+3
  984. NC1=NBV0+(K-1)*8+1
  985. NC2=NBV0+(K-1)*8+2
  986. NC3=NBV0+(K-1)*8+3
  987. NC4=NBV0+(K-1)*8+4
  988. NC5=NBV0+(K-1)*8+5
  989. NC6=NBV0+(K-1)*8+6
  990. NC7=NBV0+(K-1)*8+7
  991. NC8=NBV0+(K-1)*8+8
  992.  
  993. DO 2101 M=1,3
  994. XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M)
  995. XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M)
  996. XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M)
  997. XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M)
  998. XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M)
  999. XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M)
  1000. XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M)
  1001. XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M)
  1002. XA(M,9)=XCOOR((N9-1)*(IDIM+1) +M)
  1003. XA(M,10)=XCOOR((N10-1)*(IDIM+1) +M)
  1004. XA(M,11)=XCOOR((N11-1)*(IDIM+1) +M)
  1005. XA(M,12)=XCOOR((N12-1)*(IDIM+1) +M)
  1006. XA(M,13)=XCOOR((N13-1)*(IDIM+1) +M)
  1007. XA(M,14)=XCOOR((N14-1)*(IDIM+1) +M)
  1008. XA(M,15)=XCOOR((N15-1)*(IDIM+1) +M)
  1009. 2101 CONTINUE
  1010.  
  1011. CALL FFPR15(XA)
  1012. C write(6,*)' X'
  1013. C write(6,1002)(XA(1,j),j=16,18)
  1014. C write(6,*)' Y'
  1015. C write(6,1002)(XA(2,j),j=16,18)
  1016. C write(6,*)' Z'
  1017. C write(6,1002)(XA(3,j),j=16,18)
  1018.  
  1019. DO 2102 M=1,3
  1020.  
  1021. XCOOR((N16-1)*(IDIM+1) +M)=XA(M,16)
  1022. XCOOR((N17-1)*(IDIM+1) +M)=XA(M,17)
  1023. XCOOR((N18-1)*(IDIM+1) +M)=XA(M,18)
  1024.  
  1025. XNC1 =(XA(M,1)+XA(M,2)+XA(M,6)+XA(M,7)+XA(M,16)+XA(M,18))/6.D0
  1026. XCOOR((NC1 -1)*(IDIM+1) +M)=XNC1
  1027.  
  1028. XNC2 =(XA(M,2)+XA(M,3)+XA(M,4)+XA(M,16)+XA(M,8)+XA(M,17))/6.D0
  1029. XCOOR((NC2 -1)*(IDIM+1) +M)=XNC2
  1030.  
  1031. XNC3 =(XA(M,4)+XA(M,5)+XA(M,6)+XA(M,17)+XA(M,9)+XA(M,18))/6.D0
  1032. XCOOR((NC3 -1)*(IDIM+1) +M)=XNC3
  1033.  
  1034. XNC4 =(XA(M,2)+XA(M,4)+XA(M,6)+XA(M,16)+XA(M,17)+XA(M,18))/6.D0
  1035. XCOOR((NC4 -1)*(IDIM+1) +M)=XNC4
  1036.  
  1037. XNC5 =(XA(M,7)+XA(M,16)+XA(M,18)+XA(M,10)+XA(M,11)+XA(M,15))/6.D0
  1038. XCOOR((NC5 -1)*(IDIM+1) +M)=XNC5
  1039.  
  1040. XNC6 =(XA(M,16)+XA(M,8)+XA(M,17)+XA(M,11)+XA(M,12)+XA(M,13))/6.D0
  1041. XCOOR((NC6 -1)*(IDIM+1) +M)=XNC6
  1042.  
  1043. XNC7 =(XA(M,18)+XA(M,17)+XA(M,9)+XA(M,15)+XA(M,13)+XA(M,14))/6.D0
  1044. XCOOR((NC7 -1)*(IDIM+1) +M)=XNC7
  1045.  
  1046. XNC8 =(XA(M,16)+XA(M,17)+XA(M,18)+XA(M,11)+XA(M,13)+XA(M,15))/6.D0
  1047. XCOOR((NC8 -1)*(IDIM+1) +M)=XNC8
  1048.  
  1049.  
  1050. 2102 CONTINUE
  1051.  
  1052. MCTREI.NUM(1,NCTR0+K1+1)=NC1
  1053. MCTREI.NUM(1,NCTR0+K1+2)=NC2
  1054. MCTREI.NUM(1,NCTR0+K1+3)=NC3
  1055. MCTREI.NUM(1,NCTR0+K1+4)=NC4
  1056. MCTREI.NUM(1,NCTR0+K1+5)=NC5
  1057. MCTREI.NUM(1,NCTR0+K1+6)=NC6
  1058. MCTREI.NUM(1,NCTR0+K1+7)=NC7
  1059. MCTREI.NUM(1,NCTR0+K1+8)=NC8
  1060.  
  1061. IPT2.NUM(1,K1+1)=N1
  1062. IPT2.NUM(2,K1+1)=N2
  1063. IPT2.NUM(3,K1+1)=N6
  1064. IPT2.NUM(4,K1+1)=N7
  1065. IPT2.NUM(5,K1+1)=N16
  1066. IPT2.NUM(6,K1+1)=N18
  1067.  
  1068. IPT2.NUM(1,K1+2)=N2
  1069. IPT2.NUM(2,K1+2)=N3
  1070. IPT2.NUM(3,K1+2)=N4
  1071. IPT2.NUM(4,K1+2)=N16
  1072. IPT2.NUM(5,K1+2)=N8
  1073. IPT2.NUM(6,K1+2)=N17
  1074.  
  1075. IPT2.NUM(1,K1+3)=N4
  1076. IPT2.NUM(2,K1+3)=N5
  1077. IPT2.NUM(3,K1+3)=N6
  1078. IPT2.NUM(4,K1+3)=N17
  1079. IPT2.NUM(5,K1+3)=N9
  1080. IPT2.NUM(6,K1+3)=N18
  1081.  
  1082. IPT2.NUM(1,K1+4)=N2
  1083. IPT2.NUM(2,K1+4)=N4
  1084. IPT2.NUM(3,K1+4)=N6
  1085. IPT2.NUM(4,K1+4)=N16
  1086. IPT2.NUM(5,K1+4)=N17
  1087. IPT2.NUM(6,K1+4)=N18
  1088.  
  1089. IPT2.NUM(1,K1+5)=N7
  1090. IPT2.NUM(2,K1+5)=N16
  1091. IPT2.NUM(3,K1+5)=N18
  1092. IPT2.NUM(4,K1+5)=N10
  1093. IPT2.NUM(5,K1+5)=N11
  1094. IPT2.NUM(6,K1+5)=N15
  1095.  
  1096. IPT2.NUM(1,K1+6)=N16
  1097. IPT2.NUM(2,K1+6)=N8
  1098. IPT2.NUM(3,K1+6)=N17
  1099. IPT2.NUM(4,K1+6)=N11
  1100. IPT2.NUM(5,K1+6)=N12
  1101. IPT2.NUM(6,K1+6)=N13
  1102.  
  1103. IPT2.NUM(1,K1+7)=N18
  1104. IPT2.NUM(2,K1+7)=N17
  1105. IPT2.NUM(3,K1+7)=N9
  1106. IPT2.NUM(4,K1+7)=N15
  1107. IPT2.NUM(5,K1+7)=N13
  1108. IPT2.NUM(6,K1+7)=N14
  1109.  
  1110. IPT2.NUM(1,K1+8)=N16
  1111. IPT2.NUM(2,K1+8)=N17
  1112. IPT2.NUM(3,K1+8)=N18
  1113. IPT2.NUM(4,K1+8)=N11
  1114. IPT2.NUM(5,K1+8)=N13
  1115. IPT2.NUM(6,K1+8)=N15
  1116.  
  1117.  
  1118. K1=K1+8
  1119.  
  1120. C DF1
  1121. DO 21001 M=1,3
  1122. XYZ(M,1)=XA(M,6)
  1123. XYZ(M,2)=XA(M,2 )
  1124. XYZ(M,3)=XA(M,16)
  1125. XYZ(M,4)=XA(M,18)
  1126. 21001 CONTINUE
  1127.  
  1128. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)
  1129.  
  1130. AIR1=ABS(AIR1)
  1131. DF1=SQRT(AIR1)
  1132.  
  1133. C DF2
  1134. DO 21002 M=1,3
  1135. XYZ(M,1)=XA(M,2)
  1136. XYZ(M,2)=XA(M,4 )
  1137. XYZ(M,3)=XA(M,17)
  1138. XYZ(M,4)=XA(M,16)
  1139. 21002 CONTINUE
  1140.  
  1141. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)
  1142.  
  1143. AIR2=ABS(AIR2)
  1144. DF2=SQRT(AIR2)
  1145.  
  1146. C DF3
  1147. DO 21003 M=1,3
  1148. XYZ(M,1)=XA(M,4)
  1149. XYZ(M,2)=XA(M,6 )
  1150. XYZ(M,3)=XA(M,18)
  1151. XYZ(M,4)=XA(M,17)
  1152. 21003 CONTINUE
  1153.  
  1154. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)
  1155.  
  1156. AIR3=ABS(AIR3)
  1157. DF3=SQRT(AIR3)
  1158.  
  1159. C DF4
  1160. DO 21004 M=1,3
  1161. IZHR1.XYZ(M,1)=XA(M,7)
  1162. IZHR1.XYZ(M,2)=XA(M,16)
  1163. IZHR1.XYZ(M,3)=XA(M,18)
  1164. 21004 CONTINUE
  1165.  
  1166. CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
  1167. & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR4)
  1168.  
  1169. AIR4=ABS(AIR4)
  1170. DF4=SQRT(AIR4)
  1171.  
  1172. C DF5
  1173. DO 21005 M=1,3
  1174. IZHR1.XYZ(M,1)=XA(M,16)
  1175. IZHR1.XYZ(M,2)=XA(M,8 )
  1176. IZHR1.XYZ(M,3)=XA(M,17)
  1177. 21005 CONTINUE
  1178.  
  1179. CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
  1180. & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR5)
  1181.  
  1182. AIR5=ABS(AIR5)
  1183. DF5=SQRT(AIR5)
  1184.  
  1185. C DF6
  1186. DO 21006 M=1,3
  1187. IZHR1.XYZ(M,1)=XA(M,18)
  1188. IZHR1.XYZ(M,2)=XA(M,17)
  1189. IZHR1.XYZ(M,3)=XA(M,9 )
  1190. 21006 CONTINUE
  1191.  
  1192. CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
  1193. & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR6)
  1194.  
  1195. AIR6=ABS(AIR6)
  1196. DF6=SQRT(AIR6)
  1197.  
  1198. C DF7
  1199. DO 21007 M=1,3
  1200. IZHR1.XYZ(M,1)=XA(M,16)
  1201. IZHR1.XYZ(M,2)=XA(M,17)
  1202. IZHR1.XYZ(M,3)=XA(M,18)
  1203. 21007 CONTINUE
  1204.  
  1205. CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
  1206. & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR7)
  1207.  
  1208. AIR7=ABS(AIR7)
  1209. DF7=SQRT(AIR7)
  1210.  
  1211. C DF8
  1212. DO 21008 M=1,3
  1213. XYZ(M,1)=XA(M,18)
  1214. XYZ(M,2)=XA(M,16)
  1215. XYZ(M,3)=XA(M,11)
  1216. XYZ(M,4)=XA(M,15)
  1217. 21008 CONTINUE
  1218.  
  1219. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8)
  1220.  
  1221. AIR8=ABS(AIR8)
  1222. DF8=SQRT(AIR8)
  1223.  
  1224. C DF9
  1225. DO 21009 M=1,3
  1226. XYZ(M,1)=XA(M,16)
  1227. XYZ(M,2)=XA(M,17)
  1228. XYZ(M,3)=XA(M,13)
  1229. XYZ(M,4)=XA(M,11)
  1230. 21009 CONTINUE
  1231.  
  1232. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR9)
  1233.  
  1234. AIR9=ABS(AIR9)
  1235. DF9=SQRT(AIR9)
  1236.  
  1237. C DF10
  1238. DO 21010 M=1,3
  1239. XYZ(M,1)=XA(M,18)
  1240. XYZ(M,2)=XA(M,17)
  1241. XYZ(M,3)=XA(M,13)
  1242. XYZ(M,4)=XA(M,15)
  1243. 21010 CONTINUE
  1244.  
  1245. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR10)
  1246.  
  1247. AIR10=ABS(AIR10)
  1248. DF10=SQRT(AIR10)
  1249.  
  1250.  
  1251. DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8+DF9+DF10)/10.D0
  1252. AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6
  1253. & +AIR7+AIR8+AIR9+AIR10)/10.D0
  1254.  
  1255. MELSTB.NUM(1,NCSTB+K)=NC1
  1256. MELSTB.NUM(2,NCSTB+K)=NC2
  1257. MELSTB.NUM(3,NCSTB+K)=NC3
  1258. MELSTB.NUM(4,NCSTB+K)=NC4
  1259. MELSTB.NUM(5,NCSTB+K)=NC5
  1260. MELSTB.NUM(6,NCSTB+K)=NC6
  1261. MELSTB.NUM(7,NCSTB+K)=NC7
  1262. MELSTB.NUM(8,NCSTB+K)=NC8
  1263.  
  1264. MELSTB.NUM(1,NCSTB+K+1)=NC2
  1265. MELSTB.NUM(2,NCSTB+K+1)=NC3
  1266. MELSTB.NUM(3,NCSTB+K+1)=NC4
  1267. MELSTB.NUM(4,NCSTB+K+1)=NC5
  1268. MELSTB.NUM(5,NCSTB+K+1)=NC6
  1269. MELSTB.NUM(6,NCSTB+K+1)=NC7
  1270. MELSTB.NUM(7,NCSTB+K+1)=NC8
  1271. MELSTB.NUM(8,NCSTB+K+1)=NC1
  1272.  
  1273. MELSTB.NUM(1,NCSTB+K+2)=NC3
  1274. MELSTB.NUM(2,NCSTB+K+2)=NC4
  1275. MELSTB.NUM(3,NCSTB+K+2)=NC5
  1276. MELSTB.NUM(4,NCSTB+K+2)=NC6
  1277. MELSTB.NUM(5,NCSTB+K+2)=NC7
  1278. MELSTB.NUM(6,NCSTB+K+2)=NC8
  1279. MELSTB.NUM(7,NCSTB+K+2)=NC1
  1280. MELSTB.NUM(8,NCSTB+K+2)=NC2
  1281.  
  1282. MELSTB.NUM(1,NCSTB+K+3)=NC4
  1283. MELSTB.NUM(2,NCSTB+K+3)=NC5
  1284. MELSTB.NUM(3,NCSTB+K+3)=NC6
  1285. MELSTB.NUM(4,NCSTB+K+3)=NC7
  1286. MELSTB.NUM(5,NCSTB+K+3)=NC8
  1287. MELSTB.NUM(6,NCSTB+K+3)=NC1
  1288. MELSTB.NUM(7,NCSTB+K+3)=NC2
  1289. MELSTB.NUM(8,NCSTB+K+3)=NC3
  1290.  
  1291. MELSTB.NUM(1,NCSTB+K+4)=NC5
  1292. MELSTB.NUM(2,NCSTB+K+4)=NC6
  1293. MELSTB.NUM(3,NCSTB+K+4)=NC7
  1294. MELSTB.NUM(4,NCSTB+K+4)=NC8
  1295. MELSTB.NUM(5,NCSTB+K+4)=NC1
  1296. MELSTB.NUM(6,NCSTB+K+4)=NC2
  1297. MELSTB.NUM(7,NCSTB+K+4)=NC3
  1298. MELSTB.NUM(8,NCSTB+K+4)=NC4
  1299.  
  1300. MELSTB.NUM(1,NCSTB+K+5)=NC6
  1301. MELSTB.NUM(2,NCSTB+K+5)=NC7
  1302. MELSTB.NUM(3,NCSTB+K+5)=NC8
  1303. MELSTB.NUM(4,NCSTB+K+5)=NC1
  1304. MELSTB.NUM(5,NCSTB+K+5)=NC2
  1305. MELSTB.NUM(6,NCSTB+K+5)=NC3
  1306. MELSTB.NUM(7,NCSTB+K+5)=NC4
  1307. MELSTB.NUM(8,NCSTB+K+5)=NC5
  1308.  
  1309. MELSTB.NUM(1,NCSTB+K+6)=NC7
  1310. MELSTB.NUM(2,NCSTB+K+6)=NC8
  1311. MELSTB.NUM(3,NCSTB+K+6)=NC1
  1312. MELSTB.NUM(4,NCSTB+K+6)=NC2
  1313. MELSTB.NUM(5,NCSTB+K+6)=NC3
  1314. MELSTB.NUM(6,NCSTB+K+6)=NC4
  1315. MELSTB.NUM(7,NCSTB+K+6)=NC5
  1316. MELSTB.NUM(8,NCSTB+K+6)=NC6
  1317.  
  1318. MELSTB.NUM(1,NCSTB+K+7)=NC8
  1319. MELSTB.NUM(2,NCSTB+K+7)=NC1
  1320. MELSTB.NUM(3,NCSTB+K+7)=NC2
  1321. MELSTB.NUM(4,NCSTB+K+7)=NC3
  1322. MELSTB.NUM(5,NCSTB+K+7)=NC4
  1323. MELSTB.NUM(6,NCSTB+K+7)=NC5
  1324. MELSTB.NUM(7,NCSTB+K+7)=NC6
  1325. MELSTB.NUM(8,NCSTB+K+7)=NC7
  1326.  
  1327. C write(6,1002)air1,air2,air3,air4,air5,air6,air7,air8,air9,
  1328. C &air10
  1329. C write(6,1002)df3,df4,df5,df6,df7,df8,df9,df10
  1330. H12=AIRM*DFM*EPS(5)
  1331. H13=AIRM*DFM*EPS(5)
  1332. H14=AIR1*DF1*GA(5)
  1333. H15=AIR4*DF4*GA(5)
  1334. H16=AIRM*DFM*EPS(5)
  1335. H17=AIRM*DFM*EPS(5)
  1336. H18=AIRM*DFM*EPS(5)
  1337.  
  1338. H23=AIRM*DFM*EPS(5)
  1339. H24=AIR2*DF2*GA(5)
  1340. H25=AIRM*DFM*EPS(5)
  1341. H26=AIR5*DF5*GA(5)
  1342. H27=AIRM*DFM*EPS(5)
  1343. H28=AIRM*DFM*EPS(5)
  1344.  
  1345. H34=AIR3*DF3*GA(5)
  1346. H35=AIRM*DFM*EPS(5)
  1347. H36=AIRM*DFM*EPS(5)
  1348. H37=AIR6*DF6*GA(5)
  1349. H38=AIRM*DFM*EPS(5)
  1350.  
  1351. H45=AIRM*DFM*EPS(5)
  1352. H46=AIRM*DFM*EPS(5)
  1353. H47=AIRM*DFM*EPS(5)
  1354. H48=AIR7*DF7*GA(5)
  1355.  
  1356. H56=AIRM*DFM*EPS(5)
  1357. H57=AIRM*DFM*EPS(5)
  1358. H58=AIR8*DF8*GA(5)
  1359.  
  1360. H67=AIRM*DFM*EPS(5)
  1361. H68=AIR9*DF9*GA(5)
  1362.  
  1363. H78=AIR10*DF10*GA(5)
  1364.  
  1365. MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18
  1366. MPOVA1.VPOCHA(NCTV0+K,2)=-H12
  1367. MPOVA1.VPOCHA(NCTV0+K,3)=-H13
  1368. MPOVA1.VPOCHA(NCTV0+K,4)=-H14
  1369. MPOVA1.VPOCHA(NCTV0+K,5)=-H15
  1370. MPOVA1.VPOCHA(NCTV0+K,6)=-H16
  1371. MPOVA1.VPOCHA(NCTV0+K,7)=-H17
  1372. MPOVA1.VPOCHA(NCTV0+K,8)=-H18
  1373. MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28
  1374. MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
  1375. MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
  1376. MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25
  1377. MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26
  1378. MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27
  1379. MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28
  1380. MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12
  1381. MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38
  1382. MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
  1383. MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35
  1384. MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36
  1385. MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37
  1386. MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38
  1387. MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13
  1388. MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23
  1389. MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48
  1390. MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45
  1391. MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46
  1392. MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47
  1393. MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48
  1394. MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14
  1395. MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24
  1396. MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34
  1397. MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58
  1398. MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56
  1399. MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57
  1400. MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58
  1401. MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15
  1402. MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25
  1403. MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35
  1404. MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45
  1405. MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68
  1406. MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67
  1407. MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68
  1408. MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16
  1409. MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26
  1410. MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36
  1411. MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46
  1412. MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56
  1413. MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78
  1414. MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78
  1415. MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17
  1416. MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27
  1417. MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37
  1418. MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47
  1419. MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57
  1420. MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67
  1421. MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78
  1422. MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18
  1423. MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28
  1424. MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38
  1425. MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48
  1426. MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58
  1427. MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68
  1428. MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78
  1429. KPOC=1
  1430. NCTV0=NCTV0+7
  1431. NCSTB=NCSTB+7
  1432.  
  1433.  
  1434. 215 CONTINUE
  1435. SEGDES IPT1,IPT2
  1436. GO TO 1
  1437.  
  1438. C**************************************************************************
  1439.  
  1440. 113 CONTINUE
  1441. WRITE(6,*)'Opérateur DOMA : Les éléments PY13 ne sont pas traités'
  1442. IRET=0
  1443. RETURN
  1444.  
  1445. C**************************************************************************
  1446. C TE10 -> 8 TET4
  1447.  
  1448. 110 CONTINUE
  1449. C write(6,*)' TE10 -> 8 TET4 '
  1450. NBEL=IPT1.NUM(/2)
  1451. NP=IPT1.NUM(/1)
  1452. NBPC=NBEL*8
  1453.  
  1454. N=NBPC+MPOVA1.VPOCHA(/1)
  1455. NC=8
  1456. NCTV0=MPOVA1.VPOCHA(/1)
  1457. SEGADJ MPOVA1
  1458.  
  1459. NBV0=XCOOR(/1)/(IDIM+1)
  1460. NBPTS=NBV0+NBPC
  1461. SEGADJ MCOORD
  1462.  
  1463. C maillage de lineaires
  1464. NBELEM=8*NBEL
  1465. NBNN=4
  1466. NBSOUS=0
  1467. NBREF=0
  1468. SEGINI IPT2
  1469. IPT2.ITYPEL=23
  1470. IM=IM+1
  1471. ITAB(IM)=IPT2
  1472.  
  1473. C Spg des pts centres des macro elements
  1474. NCTR0=MCTREI.NUM(/2)
  1475. NBELEM=NCTR0+NBPC
  1476. NBNN=1
  1477. NBSOUS=0
  1478. NBREF=0
  1479. SEGADJ MCTREI
  1480. KCTREI=1
  1481.  
  1482. C Connectivités de la matrice de stabilisation
  1483. NCSTB=MELSTB.NUM(/2)
  1484. NBELEM=NCSTB+NBPC
  1485. NBNN=8
  1486. C write(6,*)' KTRS3 : ',nbnn,nbelem
  1487. NBSOUS=0
  1488. NBREF=0
  1489. SEGADJ MELSTB
  1490. KSTB=1
  1491.  
  1492. CALL KALPBG('TRI3 ','FONFORM0',IZFFM)
  1493. IF(IZFFM.EQ.0)CALL ARRET(0)
  1494. SEGACT IZFFM*MOD
  1495. IZHR=KZHR(1)
  1496. SEGACT IZHR*MOD
  1497. NPG=GR(/3)
  1498. NES=GR(/1)
  1499. NPI=3
  1500.  
  1501. C write(6,*)' NBEL=',nbel
  1502.  
  1503. K1=0
  1504. DO 210 K=1,NBEL
  1505. N1=IPT1.NUM(1,K)
  1506. N2=IPT1.NUM(2,K)
  1507. N3=IPT1.NUM(3,K)
  1508. N4=IPT1.NUM(4,K)
  1509. N5=IPT1.NUM(5,K)
  1510. N6=IPT1.NUM(6,K)
  1511. N7=IPT1.NUM(7,K)
  1512. N8=IPT1.NUM(8,K)
  1513. N9=IPT1.NUM(9,K)
  1514. N10=IPT1.NUM(10,K)
  1515. NC1=NBV0+(K-1)*8+1
  1516. NC2=NBV0+(K-1)*8+2
  1517. NC3=NBV0+(K-1)*8+3
  1518. NC4=NBV0+(K-1)*8+4
  1519. NC5=NBV0+(K-1)*8+5
  1520. NC6=NBV0+(K-1)*8+6
  1521. NC7=NBV0+(K-1)*8+7
  1522. NC8=NBV0+(K-1)*8+8
  1523.  
  1524. DO 2111 M=1,3
  1525. XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M)
  1526. XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M)
  1527. XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M)
  1528. XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M)
  1529. XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M)
  1530. XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M)
  1531. XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M)
  1532. XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M)
  1533. XA(M,9)=XCOOR((N9-1)*(IDIM+1) +M)
  1534. XA(M,10)=XCOOR((N10-1)*(IDIM+1) +M)
  1535. 2111 CONTINUE
  1536.  
  1537. DO 2112 M=1,3
  1538.  
  1539. XNC1 =(XA(M,1)+XA(M,2)+XA(M,6)+XA(M,7))/4.D0
  1540. XCOOR((NC1 -1)*(IDIM+1) +M)=XNC1
  1541.  
  1542. XNC2 =(XA(M,2)+XA(M,3)+XA(M,4)+XA(M,8))/4.D0
  1543. XCOOR((NC2 -1)*(IDIM+1) +M)=XNC2
  1544.  
  1545. XNC3 =(XA(M,4)+XA(M,5)+XA(M,6)+XA(M,9))/4.D0
  1546. XCOOR((NC3 -1)*(IDIM+1) +M)=XNC3
  1547.  
  1548. XNC4 =(XA(M,7)+XA(M,8)+XA(M,9)+XA(M,10))/4.D0
  1549. XCOOR((NC4 -1)*(IDIM+1) +M)=XNC4
  1550.  
  1551. XNC5 =(XA(M,2)+XA(M,6)+XA(M,7)+XA(M,8))/4.D0
  1552. XCOOR((NC5 -1)*(IDIM+1) +M)=XNC5
  1553.  
  1554. XNC6 =(XA(M,6)+XA(M,8)+XA(M,9)+XA(M,7))/4.D0
  1555. XCOOR((NC6 -1)*(IDIM+1) +M)=XNC6
  1556.  
  1557. XNC7 =(XA(M,6)+XA(M,8)+XA(M,2)+XA(M,4))/4.D0
  1558. XCOOR((NC7 -1)*(IDIM+1) +M)=XNC7
  1559.  
  1560. XNC8 =(XA(M,6)+XA(M,8)+XA(M,9)+XA(M,4))/4.D0
  1561. XCOOR((NC8 -1)*(IDIM+1) +M)=XNC8
  1562.  
  1563.  
  1564. 2112 CONTINUE
  1565.  
  1566. MCTREI.NUM(1,NCTR0+K1+1)=NC1
  1567. MCTREI.NUM(1,NCTR0+K1+2)=NC2
  1568. MCTREI.NUM(1,NCTR0+K1+3)=NC3
  1569. MCTREI.NUM(1,NCTR0+K1+4)=NC4
  1570. MCTREI.NUM(1,NCTR0+K1+5)=NC5
  1571. MCTREI.NUM(1,NCTR0+K1+6)=NC6
  1572. MCTREI.NUM(1,NCTR0+K1+7)=NC7
  1573. MCTREI.NUM(1,NCTR0+K1+8)=NC8
  1574.  
  1575. IPT2.NUM(1,K1+1)=N1
  1576. IPT2.NUM(2,K1+1)=N2
  1577. IPT2.NUM(3,K1+1)=N6
  1578. IPT2.NUM(4,K1+1)=N7
  1579.  
  1580. IPT2.NUM(1,K1+2)=N3
  1581. IPT2.NUM(2,K1+2)=N4
  1582. IPT2.NUM(3,K1+2)=N8
  1583. IPT2.NUM(4,K1+2)=N2
  1584.  
  1585. IPT2.NUM(1,K1+3)=N5
  1586. IPT2.NUM(2,K1+3)=N6
  1587. IPT2.NUM(3,K1+3)=N4
  1588. IPT2.NUM(4,K1+3)=N9
  1589.  
  1590. IPT2.NUM(1,K1+4)=N7
  1591. IPT2.NUM(2,K1+4)=N8
  1592. IPT2.NUM(3,K1+4)=N9
  1593. IPT2.NUM(4,K1+4)=N10
  1594.  
  1595. IPT2.NUM(1,K1+5)=N2
  1596. IPT2.NUM(2,K1+5)=N6
  1597. IPT2.NUM(3,K1+5)=N7
  1598. IPT2.NUM(4,K1+5)=N8
  1599.  
  1600. IPT2.NUM(1,K1+6)=N6
  1601. IPT2.NUM(2,K1+6)=N8
  1602. IPT2.NUM(3,K1+6)=N9
  1603. IPT2.NUM(4,K1+6)=N7
  1604.  
  1605. IPT2.NUM(1,K1+7)=N6
  1606. IPT2.NUM(2,K1+7)=N8
  1607. IPT2.NUM(3,K1+7)=N2
  1608. IPT2.NUM(4,K1+7)=N4
  1609.  
  1610. IPT2.NUM(1,K1+8)=N6
  1611. IPT2.NUM(2,K1+8)=N8
  1612. IPT2.NUM(3,K1+8)=N9
  1613. IPT2.NUM(4,K1+8)=N4
  1614.  
  1615.  
  1616. K1=K1+8
  1617.  
  1618. C DF1
  1619. DO 21101 M=1,3
  1620. XYZ(M,1)=XA(M,2)
  1621. XYZ(M,2)=XA(M,6)
  1622. XYZ(M,3)=XA(M,7)
  1623. 21101 CONTINUE
  1624.  
  1625. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)
  1626.  
  1627. AIR1=ABS(AIR1)
  1628. DF1=SQRT(AIR1)
  1629.  
  1630. C DF2
  1631. DO 21102 M=1,3
  1632. XYZ(M,1)=XA(M,2)
  1633. XYZ(M,2)=XA(M,4)
  1634. XYZ(M,3)=XA(M,6)
  1635. 21102 CONTINUE
  1636.  
  1637. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)
  1638.  
  1639. AIR2=ABS(AIR2)
  1640. DF2=SQRT(AIR2)
  1641.  
  1642. C DF3
  1643. DO 21103 M=1,3
  1644. XYZ(M,1)=XA(M,7)
  1645. XYZ(M,2)=XA(M,6)
  1646. XYZ(M,3)=XA(M,8)
  1647. 21103 CONTINUE
  1648.  
  1649. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)
  1650.  
  1651. AIR3=ABS(AIR3)
  1652. DF3=SQRT(AIR3)
  1653.  
  1654. C DF4
  1655. DO 21104 M=1,3
  1656. XYZ(M,1)=XA(M,2)
  1657. XYZ(M,2)=XA(M,8)
  1658. XYZ(M,3)=XA(M,6)
  1659. 21104 CONTINUE
  1660.  
  1661. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4)
  1662.  
  1663. AIR4=ABS(AIR4)
  1664. DF4=SQRT(AIR4)
  1665.  
  1666. C DF5
  1667. DO 21105 M=1,3
  1668. XYZ(M,1)=XA(M,6)
  1669. XYZ(M,2)=XA(M,9)
  1670. XYZ(M,3)=XA(M,8)
  1671. 21105 CONTINUE
  1672.  
  1673. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR5)
  1674.  
  1675. AIR5=ABS(AIR5)
  1676. DF5=SQRT(AIR5)
  1677.  
  1678. C DF6
  1679. DO 21106 M=1,3
  1680. XYZ(M,1)=XA(M,6)
  1681. XYZ(M,2)=XA(M,8)
  1682. XYZ(M,3)=XA(M,4)
  1683. 21106 CONTINUE
  1684.  
  1685. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR6)
  1686.  
  1687. AIR6=ABS(AIR6)
  1688. DF6=SQRT(AIR6)
  1689.  
  1690. C DF7
  1691. DO 21107 M=1,3
  1692. XYZ(M,1)=XA(M,7)
  1693. XYZ(M,2)=XA(M,8)
  1694. XYZ(M,3)=XA(M,9)
  1695. 21107 CONTINUE
  1696.  
  1697. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR7)
  1698.  
  1699. AIR7=ABS(AIR7)
  1700. DF7=SQRT(AIR7)
  1701.  
  1702. C DF8
  1703. DO 21108 M=1,3
  1704. XYZ(M,1)=XA(M,9)
  1705. XYZ(M,2)=XA(M,6)
  1706. XYZ(M,3)=XA(M,4)
  1707. 21108 CONTINUE
  1708.  
  1709. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8)
  1710.  
  1711. AIR8=ABS(AIR8)
  1712. DF8=SQRT(AIR8)
  1713.  
  1714.  
  1715. DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8)/8.D0
  1716. AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6+AIR7+AIR8)/8.D0
  1717.  
  1718. MELSTB.NUM(1,NCSTB+K)=NC1
  1719. MELSTB.NUM(2,NCSTB+K)=NC2
  1720. MELSTB.NUM(3,NCSTB+K)=NC3
  1721. MELSTB.NUM(4,NCSTB+K)=NC4
  1722. MELSTB.NUM(5,NCSTB+K)=NC5
  1723. MELSTB.NUM(6,NCSTB+K)=NC6
  1724. MELSTB.NUM(7,NCSTB+K)=NC7
  1725. MELSTB.NUM(8,NCSTB+K)=NC8
  1726.  
  1727. MELSTB.NUM(1,NCSTB+K+1)=NC2
  1728. MELSTB.NUM(2,NCSTB+K+1)=NC3
  1729. MELSTB.NUM(3,NCSTB+K+1)=NC4
  1730. MELSTB.NUM(4,NCSTB+K+1)=NC5
  1731. MELSTB.NUM(5,NCSTB+K+1)=NC6
  1732. MELSTB.NUM(6,NCSTB+K+1)=NC7
  1733. MELSTB.NUM(7,NCSTB+K+1)=NC8
  1734. MELSTB.NUM(8,NCSTB+K+1)=NC1
  1735.  
  1736. MELSTB.NUM(1,NCSTB+K+2)=NC3
  1737. MELSTB.NUM(2,NCSTB+K+2)=NC4
  1738. MELSTB.NUM(3,NCSTB+K+2)=NC5
  1739. MELSTB.NUM(4,NCSTB+K+2)=NC6
  1740. MELSTB.NUM(5,NCSTB+K+2)=NC7
  1741. MELSTB.NUM(6,NCSTB+K+2)=NC8
  1742. MELSTB.NUM(7,NCSTB+K+2)=NC1
  1743. MELSTB.NUM(8,NCSTB+K+2)=NC2
  1744.  
  1745. MELSTB.NUM(1,NCSTB+K+3)=NC4
  1746. MELSTB.NUM(2,NCSTB+K+3)=NC5
  1747. MELSTB.NUM(3,NCSTB+K+3)=NC6
  1748. MELSTB.NUM(4,NCSTB+K+3)=NC7
  1749. MELSTB.NUM(5,NCSTB+K+3)=NC8
  1750. MELSTB.NUM(6,NCSTB+K+3)=NC1
  1751. MELSTB.NUM(7,NCSTB+K+3)=NC2
  1752. MELSTB.NUM(8,NCSTB+K+3)=NC3
  1753.  
  1754. MELSTB.NUM(1,NCSTB+K+4)=NC5
  1755. MELSTB.NUM(2,NCSTB+K+4)=NC6
  1756. MELSTB.NUM(3,NCSTB+K+4)=NC7
  1757. MELSTB.NUM(4,NCSTB+K+4)=NC8
  1758. MELSTB.NUM(5,NCSTB+K+4)=NC1
  1759. MELSTB.NUM(6,NCSTB+K+4)=NC2
  1760. MELSTB.NUM(7,NCSTB+K+4)=NC3
  1761. MELSTB.NUM(8,NCSTB+K+4)=NC4
  1762.  
  1763. MELSTB.NUM(1,NCSTB+K+5)=NC6
  1764. MELSTB.NUM(2,NCSTB+K+5)=NC7
  1765. MELSTB.NUM(3,NCSTB+K+5)=NC8
  1766. MELSTB.NUM(4,NCSTB+K+5)=NC1
  1767. MELSTB.NUM(5,NCSTB+K+5)=NC2
  1768. MELSTB.NUM(6,NCSTB+K+5)=NC3
  1769. MELSTB.NUM(7,NCSTB+K+5)=NC4
  1770. MELSTB.NUM(8,NCSTB+K+5)=NC5
  1771.  
  1772. MELSTB.NUM(1,NCSTB+K+6)=NC7
  1773. MELSTB.NUM(2,NCSTB+K+6)=NC8
  1774. MELSTB.NUM(3,NCSTB+K+6)=NC1
  1775. MELSTB.NUM(4,NCSTB+K+6)=NC2
  1776. MELSTB.NUM(5,NCSTB+K+6)=NC3
  1777. MELSTB.NUM(6,NCSTB+K+6)=NC4
  1778. MELSTB.NUM(7,NCSTB+K+6)=NC5
  1779. MELSTB.NUM(8,NCSTB+K+6)=NC6
  1780.  
  1781. MELSTB.NUM(1,NCSTB+K+7)=NC8
  1782. MELSTB.NUM(2,NCSTB+K+7)=NC1
  1783. MELSTB.NUM(3,NCSTB+K+7)=NC2
  1784. MELSTB.NUM(4,NCSTB+K+7)=NC3
  1785. MELSTB.NUM(5,NCSTB+K+7)=NC4
  1786. MELSTB.NUM(6,NCSTB+K+7)=NC5
  1787. MELSTB.NUM(7,NCSTB+K+7)=NC6
  1788. MELSTB.NUM(8,NCSTB+K+7)=NC7
  1789.  
  1790. C write(6,1002)air1,air2,air3,air4,air5,air6,air7,air8,air9,
  1791. C &air10
  1792. C write(6,1002)df3,df4,df5,df6,df7,df8,df9,df10
  1793. H12=AIRM*DFM*EPS(7)
  1794. H13=AIRM*DFM*EPS(7)
  1795. H14=AIRM*DFM*EPS(7)
  1796. H15=AIR1*DF1*GA(7)
  1797. H16=AIRM*DFM*EPS(7)
  1798. H17=AIRM*DFM*EPS(7)
  1799. H18=AIRM*DFM*EPS(7)
  1800.  
  1801. H23=AIRM*DFM*EPS(7)
  1802. H24=AIRM*DFM*EPS(7)
  1803. H25=AIRM*DFM*EPS(7)
  1804. H26=AIRM*DFM*EPS(7)
  1805. H27=AIR2*DF2*GA(7)
  1806. H28=AIRM*DFM*EPS(7)
  1807.  
  1808. H34=AIRM*DFM*EPS(7)
  1809. H35=AIRM*DFM*EPS(7)
  1810. H36=AIRM*DFM*EPS(7)
  1811. H37=AIRM*DFM*EPS(7)
  1812. H38=AIR8*DF8*GA(7)
  1813.  
  1814. H45=AIRM*DFM*EPS(7)
  1815. H46=AIR7*DF7*GA(7)
  1816. H47=AIRM*DFM*EPS(7)
  1817. H48=AIRM*DFM*EPS(7)
  1818.  
  1819. H56=AIR3*DF3*GA(7)
  1820. H57=AIR4*DF4*GA(7)
  1821. H58=AIRM*DFM*EPS(7)
  1822.  
  1823. H67=AIRM*DFM*EPS(7)
  1824. H68=AIR5*DF5*GA(7)
  1825.  
  1826. H78=AIR6*DF6*GA(7)
  1827.  
  1828. MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18
  1829. MPOVA1.VPOCHA(NCTV0+K,2)=-H12
  1830. MPOVA1.VPOCHA(NCTV0+K,3)=-H13
  1831. MPOVA1.VPOCHA(NCTV0+K,4)=-H14
  1832. MPOVA1.VPOCHA(NCTV0+K,5)=-H15
  1833. MPOVA1.VPOCHA(NCTV0+K,6)=-H16
  1834. MPOVA1.VPOCHA(NCTV0+K,7)=-H17
  1835. MPOVA1.VPOCHA(NCTV0+K,8)=-H18
  1836. MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28
  1837. MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
  1838. MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
  1839. MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25
  1840. MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26
  1841. MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27
  1842. MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28
  1843. MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12
  1844. MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38
  1845. MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
  1846. MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35
  1847. MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36
  1848. MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37
  1849. MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38
  1850. MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13
  1851. MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23
  1852. MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48
  1853. MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45
  1854. MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46
  1855. MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47
  1856. MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48
  1857. MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14
  1858. MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24
  1859. MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34
  1860. MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58
  1861. MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56
  1862. MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57
  1863. MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58
  1864. MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15
  1865. MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25
  1866. MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35
  1867. MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45
  1868. MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68
  1869. MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67
  1870. MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68
  1871. MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16
  1872. MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26
  1873. MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36
  1874. MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46
  1875. MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56
  1876. MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78
  1877. MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78
  1878. MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17
  1879. MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27
  1880. MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37
  1881. MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47
  1882. MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57
  1883. MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67
  1884. MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78
  1885. MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18
  1886. MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28
  1887. MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38
  1888. MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48
  1889. MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58
  1890. MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68
  1891. MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78
  1892. KPOC=1
  1893. NCTV0=NCTV0+7
  1894. NCSTB=NCSTB+7
  1895.  
  1896.  
  1897. 210 CONTINUE
  1898. SEGDES IPT1,IPT2
  1899. C write(6,*)' Sortie boucle',K
  1900. GO TO 1
  1901. C**************************************************************************
  1902.  
  1903.  
  1904. 1 CONTINUE
  1905. C IF(MELTFI.LISOUS(/1).EQ.1)THEN
  1906. C MEL=MELTFI.LISOUS(1)
  1907. C SEGSUP MELTFI
  1908. C MELTFI=MEL
  1909. C ENDIF
  1910.  
  1911. IF(IM.EQ.1)THEN
  1912. MELEME=ITAB(1)
  1913. ELSE
  1914. IF(IM.GT.5)THEN
  1915. WRITE(6,*)' Problemes dans DOMA option MACRO '
  1916. RETURN
  1917. ENDIF
  1918. NBELEM=0
  1919. NBNN=0
  1920. NBSOUS=IM
  1921. NBREF=0
  1922. SEGINI MELEME
  1923. DO 2 L=1,NBSOUS
  1924. LISOUS(L)=ITAB(L)
  1925. 2 CONTINUE
  1926. ENDIF
  1927. CALL ECMO(MTBT0,'MELEME','MAILLAGE',MELEME)
  1928.  
  1929. C Connectivités de la matrice de stabilisation
  1930. segact melstb
  1931.  
  1932. IF(KSTB.NE.0)THEN
  1933. CALL ECMO(MTBT0,'MELSTB','MAILLAGE',MELSTB)
  1934. ELSE
  1935. SEGSUP MELSTB
  1936. MELSTB=0
  1937. ENDIF
  1938.  
  1939. IF(KCTREI.NE.0)THEN
  1940. CALL ECMO(MTBT0,'MCTREI','MAILLAGE',MCTREI)
  1941. IF(KPOC.NE.0)THEN
  1942. MSOUP1.IGEOC=MCTREI
  1943. CALL ECMO(MTBT0,'MCHPOC','CHPOINT',MCHPO1)
  1944. ELSE
  1945. SEGSUP MCHPO1,MSOUP1,MPOVA1
  1946. ENDIF
  1947. ELSE
  1948. SEGSUP MCTREI
  1949. MCTREI=0
  1950. ENDIF
  1951.  
  1952.  
  1953. SEGDES MELEME,MACRO
  1954. 1002 FORMAT(10(1X,1PE11.4))
  1955. RETURN
  1956. END
  1957.  
  1958.  
  1959.  
  1960.  
  1961.  
  1962.  
  1963.  
  1964.  
  1965.  
  1966.  
  1967.  
  1968.  
  1969.  
  1970.  
  1971.  
  1972.  
  1973.  
  1974.  
  1975.  

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