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

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