Télécharger ktrs3.eso

Retour à la liste

Numérotation des lignes :

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

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