Télécharger kmlstb.eso

Retour à la liste

Numérotation des lignes :

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

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