Télécharger nor2d3.eso

Retour à la liste

Numérotation des lignes :

  1. C NOR2D3 SOURCE PV 09/03/12 21:29:27 6325
  2. SUBROUTINE NOR2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  3. & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  4. & MLENNE,MLENMI,MPOVCL,
  5. & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,
  6. & SCMB,INDLI,
  7. & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT,
  8. & NSOMM,NBMAX)
  9.  
  10.  
  11.  
  12. C
  13. C************************************************************************
  14. C
  15. C PROJET : CASTEM 2000
  16. C
  17. C NOM : NORV2
  18. C
  19. C DESCRIPTION : Appelle par NORV1
  20. C
  21. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  22. C
  23. C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS
  24. C
  25. C************************************************************************
  26. C
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (a-h,o-z)
  29. -INC SMLENTI
  30. -INC SMELEME
  31. -INC SMCHPOI
  32. -INC CCOPTIO
  33. -INC SMCOORD
  34. -INC SMLREEL
  35. POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  36. & MELTFA.MELEME, MELEP2.MELEME
  37. POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  38. & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  39. & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL
  40. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  41. & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,MLEFA2.MLENTI
  42. -INC SMCHAML
  43. INTEGER NBNN,NBREF
  44.  
  45.  
  46.  
  47. C
  48. C**** Variables de COOPTIO
  49. C
  50. C
  51. C**** Variables de COOPTIO
  52. C
  53. c INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  54. c & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  55. c & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  56. c & ,IECHO, IIMPI, IOSPI
  57. c & ,IDIM
  58. C & ,MCOORD
  59. c & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  60. c & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  61. c & ,NORINC,NORVAL,NORIND,NORVAD
  62. c & ,NUCROU, IPSAUV
  63.  
  64. C**** Variable de SMLENTI, SMCHPOI
  65. C
  66. INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  67. C
  68. C**** Les includes
  69. C
  70. INTEGER I1,ICOMP,ICOMGR,IGEOM
  71. & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  72. & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  73. & ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  74. & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  75. & ,NLS1,NLS2,NLFCL
  76. & ,ISOUS,IELEM,INOEUD,ICELL
  77. INTEGER ICEN2
  78. REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,VALZ,XG,XD,XF,XS1,XS2
  79. & ,YG,YD,YF,YS1,YS2,ZG,ZD,ZF,ZS1,ZS2,
  80. & PSCA,XNORM,VECX,VECY,VECZ,PSCAGX,PSCAGY,PSCAGZ,
  81. & PSCADX,PSCADY,PSCADZ,K11G,K22G,K21G,K31G,K32G,K33G,
  82. & K11D,K22D,K21D,K31D,K32D,K33D,VXG1,VXG2,
  83. & VXAU,VYAU,VZAU,VXD1,VXD2,VYG1,VYG2,VYD1,VYD2,VZG1,
  84. & VZG2,VZD1,VZD2,TRG1,TRG2,
  85. & TRD1,TRD2,TRG,TRD
  86. REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  87. & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,VZ,
  88. & COEF1X,COEF2X,COEF1Y,COEF2Y,COEF1Z,COEF2Z,
  89. & CX,CY,CZ,ANCX,ANCY,ANCZ,DIFFX,DIFFY,DIFFZ,XLONGG,XLONGD,
  90. & VALD,VALG,COEF,GX,GY,GZ,XMINK11,XMAXK11,XMINK22,XMAXK22,
  91. & QIMPX,QIMPY,QIMPZ,QIMPS,XLAMBDA1,XLAMBDA2
  92.  
  93. c REAL*8 VECXG1(3),VECYG1(3)
  94. c REAL*8 VECXG2(3),VECYG2(3)
  95. c REAL*8 VECXD1(3),VECYD1(3)
  96. c REAL*8 VECXD2(3),VECYD2(3)
  97. c REAL*8 EPS
  98. c INTEGER ICRIT
  99. c CHARACTER*(4) NOMCOM(18)
  100. c CHARACTER*8 TYPE
  101.  
  102. REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4)
  103. REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4)
  104. REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4)
  105. REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4)
  106. INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4)
  107. INTEGER NLOCFG(4,4),NLOCFD(4,4)
  108. REAL*8 EPS
  109. INTEGER ICRIT
  110. CHARACTER*(4) NOMCOM(18)
  111. CHARACTER*8 TYPE
  112. C
  113. DATA NOMCOM /'P1DX','P1DY',
  114. & 'P2DX','P2DY',
  115. & 'P3DX','P3DY',
  116. & 'P4DX','P4DY',
  117. & 'P5DX','P5DY',
  118. & 'P6DX','P6DY',
  119. & 'P7DX','P7DY',
  120. & 'P8DX','P8DY',
  121. & 'P9DX','P9DY'/
  122.  
  123. INTEGER NDIM
  124. SEGMENT MMAT1
  125. REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  126. INTEGER IC(NDIM)
  127. ENDSEGMENT
  128.  
  129. INTEGER K1,K2
  130. SEGMENT INDICE
  131. INTEGER NUME(K1,K2)
  132. ENDSEGMENT
  133. POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  134.  
  135. SEGMENT MATRICE
  136. REAL*8 MAT(K1,K2)
  137. ENDSEGMENT
  138. POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  139.  
  140. INTEGER K3
  141. SEGMENT POINT2
  142. INTEGER POINT(K3)
  143. ENDSEGMENT
  144. POINTEUR IPO2.POINT2
  145.  
  146. SEGMENT MATRICE2
  147. REAL*8 MAT2(K1,K2)
  148. ENDSEGMENT
  149. POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  150.  
  151.  
  152. SEGMENT REP
  153. INTEGER ID(K3)
  154. ENDSEGMENT
  155. POINTEUR TAB.REP,INDLI.REP
  156.  
  157. INTEGER K5
  158. SEGMENT NBFAC
  159. INTEGER NBFACEL(K5)
  160. INTEGER IMELEM(K5)
  161. ENDSEGMENT
  162.  
  163. INTEGER K6
  164. SEGMENT NBCOT
  165. INTEGER NBCOTE(K6)
  166. INTEGER IMECOTE(K6)
  167. ENDSEGMENT
  168.  
  169.  
  170.  
  171. c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS
  172. c SOUS DOMAINE
  173.  
  174. MAUX = MELTFA
  175. MAUX2 = MELEFP
  176. NMAI1 = 0
  177. NMAI2 = 0
  178. NMAI3 = 0
  179. NMAI4 = 0
  180. NBSO = MAX(1,MELTFA.LISOUS(/1))
  181. c WRITE(6,*) 'NBSO MAILLE= ',NBSO
  182. c WRITE(6,*) 'MELTFA= ',MELTFA
  183. IELTFA = MELTFA
  184. IF (NBSO.EQ.1) THEN
  185. K5 = MELTFA.NUM(/2)
  186. ELSEIF (NBSO.EQ.2) THEN
  187. IPT1 = MELTFA.LISOUS(1)
  188. SEGACT IPT1
  189. N1 = IPT1.NUM(/2)
  190. NMAI1 = N1
  191. SEGDES IPT1
  192. IPT2 = MELTFA.LISOUS(2)
  193. SEGACT IPT2
  194. N2 = IPT2.NUM(/2)
  195. NMAI2 = N2
  196. SEGDES IPT2
  197. K5 = N1 + N2
  198. ELSEIF (NBSO.EQ.3) THEN
  199. IPT1 = MELTFA.LISOUS(1)
  200. SEGACT IPT1
  201. N1 = IPT1.NUM(/2)
  202. NMAI1 = N1
  203. SEGDES IPT1
  204. IPT2 = MELTFA.LISOUS(2)
  205. SEGACT IPT2
  206. N2 = IPT2.NUM(/2)
  207. NMAI2 = N2
  208. SEGDES IPT2
  209. IPT3 = MELTFA.LISOUS(3)
  210. SEGACT IPT3
  211. N3 = IPT3.NUM(/2)
  212. NMAI3 = N3
  213. SEGDES IPT3
  214. K5 = N1 + N2 + N3
  215. ELSEIF (NBSO.EQ.4) THEN
  216. IPT1 = MELTFA.LISOUS(1)
  217. SEGACT IPT1
  218. N1 = IPT1.NUM(/2)
  219. NMAI1 = N1
  220. SEGDES IPT1
  221. IPT2 = MELTFA.LISOUS(2)
  222. SEGACT IPT2
  223. N2 = IPT2.NUM(/2)
  224. NMAI2 = N2
  225. SEGDES IPT2
  226. IPT3 = MELTFA.LISOUS(3)
  227. SEGACT IPT3
  228. N3 = IPT3.NUM(/2)
  229. NMAI3 = N3
  230. SEGDES IPT3
  231. IPT4 = MELTFA.LISOUS(4)
  232. SEGACT IPT4
  233. N4 = IPT4.NUM(/2)
  234. NMAI4 = N4
  235. SEGDES IPT4
  236. K5 = N1 + N2 + N3 + N4
  237. ENDIF
  238. c WRITE(6,*) 'K5= ',K5
  239.  
  240.  
  241.  
  242. IF (NBSO.EQ.1) THEN
  243. DO I = 1,K5
  244. NTYPE = MELTFA.ITYPEL
  245. c WRITE(6,*) 'NTYPE= ',NTYPE
  246. IF (NTYPE .EQ. 16) THEN
  247. NBFACEL(I) = 6
  248. IMELEM(I) = MELTFA
  249. ELSEIF (NTYPE .EQ. 25) THEN
  250. NBFACEL(I) = 5
  251. IMELEM(I) = MELTFA
  252. ELSEIF (NTYPE .EQ. 23) THEN
  253. NBFACEL(I) = 4
  254. IMELEM(I) = MELTFA
  255. ELSEIF (NTYPE .EQ. 9) THEN
  256. NBFACEL(I) = 5
  257. IMELEM(I) = MELTFA
  258. ENDIF
  259. c SEGDES MELTFA
  260. ENDDO
  261. ELSEIF (NBSO.EQ.2) THEN
  262. IPT1 = MELTFA.LISOUS(1)
  263. SEGACT IPT1
  264. IPT2 = MELTFA.LISOUS(2)
  265. SEGACT IPT2
  266. DO I = 1,K5
  267. N1 = IPT1.NUM(/2)
  268. IF (I.LE.N1) THEN
  269. NTYPE = IPT1.ITYPEL
  270. IF (NTYPE .EQ. 16) THEN
  271. NBFACEL(I) = 6
  272. IMELEM(I) = IPT1
  273. ELSEIF (NTYPE .EQ. 25) THEN
  274. NBFACEL(I) = 5
  275. IMELEM(I) = IPT1
  276. ELSEIF (NTYPE .EQ. 23) THEN
  277. NBFACEL(I) = 4
  278. IMELEM(I) = IPT1
  279. ELSEIF (NTYPE .EQ. 9) THEN
  280. NBFACEL(I) = 5
  281. IMELEM(I) = IPT1
  282. ENDIF
  283. ELSE
  284. NTYPE = IPT2.ITYPEL
  285. IF (NTYPE .EQ. 16) THEN
  286. NBFACEL(I) = 6
  287. IMELEM(I) = IPT2
  288. ELSEIF (NTYPE .EQ. 25) THEN
  289. NBFACEL(I) = 5
  290. IMELEM(I) = IPT2
  291. ELSEIF (NTYPE .EQ. 23) THEN
  292. NBFACEL(I) = 4
  293. IMELEM(I) = IPT2
  294. ELSEIF (NTYPE .EQ. 9) THEN
  295. NBFACEL(I) = 5
  296. IMELEM(I) = IPT2
  297. ENDIF
  298. ENDIF
  299. ENDDO
  300. ELSEIF (NBSO.EQ.3) THEN
  301. IPT1 = MELTFA.LISOUS(1)
  302. SEGACT IPT1
  303. NTYPE = IPT1.ITYPEL
  304. c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  305. IPT2 = MELTFA.LISOUS(2)
  306. SEGACT IPT2
  307. NTYPE = IPT2.ITYPEL
  308. c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  309. IPT3 = MELTFA.LISOUS(3)
  310. SEGACT IPT3
  311. NTYPE = IPT3.ITYPEL
  312. c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  313. N1 = IPT1.NUM(/2)
  314. N2 = IPT2.NUM(/2)
  315. N3 = IPT3.NUM(/2)
  316. DO I = 1,K5
  317. IF (I.LE.N1) THEN
  318. NTYPE = IPT1.ITYPEL
  319. IF (NTYPE .EQ. 16) THEN
  320. NBFACEL(I) = 6
  321. IMELEM(I) = IPT1
  322. ELSEIF (NTYPE .EQ. 25) THEN
  323. NBFACEL(I) = 5
  324. IMELEM(I) = IPT1
  325. ELSEIF (NTYPE .EQ. 23) THEN
  326. NBFACEL(I) = 4
  327. IMELEM(I) = IPT1
  328. ELSEIF (NTYPE .EQ. 9) THEN
  329. NBFACEL(I) = 5
  330. IMELEM(I) = IPT1
  331. ENDIF
  332. ELSEIF (I.LE.(N1+N2)) THEN
  333. NTYPE = IPT2.ITYPEL
  334. IF (NTYPE .EQ. 16) THEN
  335. NBFACEL(I) = 6
  336. IMELEM(I) = IPT2
  337. ELSEIF (NTYPE .EQ. 25) THEN
  338. NBFACEL(I) = 5
  339. IMELEM(I) = IPT2
  340. ELSEIF (NTYPE .EQ. 23) THEN
  341. NBFACEL(I) = 4
  342. IMELEM(I) = IPT2
  343. ELSEIF (NTYPE .EQ. 9) THEN
  344. NBFACEL(I) = 5
  345. IMELEM(I) = IPT2
  346. ENDIF
  347. ELSE
  348. NTYPE = IPT3.ITYPEL
  349. IF (NTYPE .EQ. 16) THEN
  350. NBFACEL(I) = 6
  351. IMELEM(I) = IPT3
  352. ELSEIF (NTYPE .EQ. 25) THEN
  353. NBFACEL(I) = 5
  354. IMELEM(I) = IPT3
  355. ELSEIF (NTYPE .EQ. 23) THEN
  356. NBFACEL(I) = 4
  357. IMELEM(I) = IPT3
  358. ELSEIF (NTYPE .EQ. 9) THEN
  359. NBFACEL(I) = 5
  360. IMELEM(I) = IPT3
  361. ENDIF
  362. ENDIF
  363. ENDDO
  364. ELSEIF (NBSO.EQ.4) THEN
  365. IPT1 = MELTFA.LISOUS(1)
  366. SEGACT IPT1
  367. NTYPE = IPT1.ITYPEL
  368. c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  369. IPT2 = MELTFA.LISOUS(2)
  370. SEGACT IPT2
  371. NTYPE = IPT2.ITYPEL
  372. c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  373. IPT3 = MELTFA.LISOUS(3)
  374. SEGACT IPT3
  375. NTYPE = IPT3.ITYPEL
  376. c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  377. IPT4 = MELTFA.LISOUS(4)
  378. SEGACT IPT4
  379. NTYPE = IPT4.ITYPEL
  380. c WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL
  381. N1 = IPT1.NUM(/2)
  382. N2 = IPT2.NUM(/2)
  383. N3 = IPT3.NUM(/2)
  384. N4 = IPT4.NUM(/2)
  385. DO I = 1,K5
  386. IF (I.LE.N1) THEN
  387. NTYPE = IPT1.ITYPEL
  388. IF (NTYPE .EQ. 16) THEN
  389. NBFACEL(I) = 6
  390. IMELEM(I) = IPT1
  391. ELSEIF (NTYPE .EQ. 25) THEN
  392. NBFACEL(I) = 5
  393. IMELEM(I) = IPT1
  394. ELSEIF (NTYPE .EQ. 23) THEN
  395. NBFACEL(I) = 4
  396. IMELEM(I) = IPT1
  397. ELSEIF (NTYPE .EQ. 9) THEN
  398. NBFACEL(I) = 5
  399. IMELEM(I) = IPT1
  400. ENDIF
  401. ELSEIF (I.LE.(N1+N2)) THEN
  402. NTYPE = IPT2.ITYPEL
  403. IF (NTYPE .EQ. 16) THEN
  404. NBFACEL(I) = 6
  405. IMELEM(I) = IPT2
  406. ELSEIF (NTYPE .EQ. 25) THEN
  407. NBFACEL(I) = 5
  408. IMELEM(I) = IPT2
  409. ELSEIF (NTYPE .EQ. 23) THEN
  410. NBFACEL(I) = 4
  411. IMELEM(I) = IPT2
  412. ELSEIF (NTYPE .EQ. 9) THEN
  413. NBFACEL(I) = 5
  414. IMELEM(I) = IPT2
  415. ENDIF
  416. ELSEIF (I.LE.(N1+N2+N3)) THEN
  417. NTYPE = IPT3.ITYPEL
  418. IF (NTYPE .EQ. 16) THEN
  419. NBFACEL(I) = 6
  420. IMELEM(I) = IPT3
  421. ELSEIF (NTYPE .EQ. 25) THEN
  422. NBFACEL(I) = 5
  423. IMELEM(I) = IPT3
  424. ELSEIF (NTYPE .EQ. 23) THEN
  425. NBFACEL(I) = 4
  426. IMELEM(I) = IPT3
  427. ELSEIF (NTYPE .EQ. 9) THEN
  428. NBFACEL(I) = 5
  429. IMELEM(I) = IPT3
  430. ENDIF
  431. ELSE
  432. NTYPE = IPT4.ITYPEL
  433. IF (NTYPE .EQ. 16) THEN
  434. NBFACEL(I) = 6
  435. IMELEM(I) = IPT4
  436. ELSEIF (NTYPE .EQ. 25) THEN
  437. NBFACEL(I) = 5
  438. IMELEM(I) = IPT4
  439. ELSEIF (NTYPE .EQ. 23) THEN
  440. NBFACEL(I) = 4
  441. IMELEM(I) = IPT4
  442. ELSEIF (NTYPE .EQ. 9) THEN
  443. NBFACEL(I) = 5
  444. IMELEM(I) = IPT4
  445. ENDIF
  446. ENDIF
  447. ENDDO
  448. ENDIF
  449.  
  450. C ON EST ICI CORRIGER K5
  451.  
  452. MLEFA2 = MLEFA
  453. CALL KRIPAD(MELEFA,MLEFA2)
  454. c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES
  455. NFAI1 = 0
  456. NBSOF = MAX(1,MELEFP.LISOUS(/1))
  457. c WRITE(6,*) 'NBSO FACE= ',NBSOF
  458. IELTFA = MELTFA
  459. IF (NBSOF.EQ.1) THEN
  460. K6 = MELEFP.NUM(/2)
  461. ELSEIF (NBSOF.EQ.2) THEN
  462. IPT5 = MELEFP.LISOUS(1)
  463. SEGACT IPT5
  464. N1 = IPT5.NUM(/2)
  465. NFAI1 = N1
  466. SEGDES IPT5
  467. IPT6 = MELEFP.LISOUS(2)
  468. SEGACT IPT6
  469. N2 = IPT6.NUM(/2)
  470. NFAI2 = N2
  471. SEGDES IPT6
  472. K6 = N1 + N2
  473. ENDIF
  474. c WRITE(6,*) 'K6= ',K6
  475.  
  476. SEGINI NBCOT
  477. c WRITE(6,*) 'POINT1'
  478. C ON EST ICI
  479. IF (NBSOF.EQ.1) THEN
  480. DO I = 1,K6
  481. NTYPE = MELEFP.ITYPEL
  482. c WRITE(6,*) 'NTYPE= ',NTYPE
  483. IF (NTYPE .EQ. 5) THEN
  484. NBCOTE(I) = 3
  485. IMECOTE(I) = MELEFP
  486. ELSE
  487. NBCOTE(I) = 4
  488. IMECOTE(I) = MELEFP
  489. ENDIF
  490. c SEGDES MELTFA
  491. ENDDO
  492. ELSEIF (NBSOF.EQ.2) THEN
  493. c WRITE(6,*) 'POINT2'
  494. IPT5 = MELEFP.LISOUS(1)
  495. SEGACT IPT5
  496. IPT6 = MELEFP.LISOUS(2)
  497. SEGACT IPT6
  498. c WRITE(6,*) 'IPT5= ',IPT5.ITYPEL
  499. c WRITE(6,*) 'IPT6= ',IPT6.ITYPEL
  500. DO I = 1,K6
  501. N1 = IPT5.NUM(/2)
  502. C MISE A JOUR DE MLEFA.LECT
  503. IF (I.LE.N1) THEN
  504. N0 = IPT5.NUM(/1)
  505. NGFAUX = IPT5.NUM(N0,I)
  506. MLEFA2.LECT(NGFAUX) = I
  507. c WRITE(6,*) 'NGFAUX = ',NGFAUX,
  508. c & 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  509. IF (IPT5.ITYPEL .EQ. 5) THEN
  510. NBCOTE(I) = 3
  511. IMECOTE(I) = IPT5
  512. ELSE
  513. NBCOTE(I) = 4
  514. IMECOTE(I) = IPT5
  515. ENDIF
  516. c SEGDES IPT5
  517. ELSE
  518. N0 = IPT6.NUM(/1)
  519. NGFAUX = IPT6.NUM(N0,I-NFAI1)
  520. MLEFA2.LECT(NGFAUX) = I
  521. c WRITE(6,*) 'NGFAUX = ',NGFAUX,
  522. c & 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  523. IF (IPT6.ITYPEL .EQ. 5) THEN
  524. NBCOTE(I) = 3
  525. IMECOTE(I) = IPT6
  526. ELSE
  527. NBCOTE(I) = 4
  528. IMECOTE(I) = IPT6
  529. ENDIF
  530. c SEGDES IPT6
  531. ENDIF
  532. c WRITE(6,*) 'I= ',I
  533. c WRITE(6,*) 'NBCOTE= ',NBCOTE(I)
  534. c WRITE(6,*) 'IMECOTE= ',IMECOTE(I)
  535.  
  536. ENDDO
  537. ENDIF
  538. C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT
  539. C EXEMPLE LES PRISMES
  540.  
  541. C SEGMENT SERVANT A UN PRECALCUL DE NBMAX
  542. c WRITE(6,*) 'NSOMM= ',NSOMM
  543. K3 = NSOMM
  544. SEGINI INDLI
  545. SEGINI TAB
  546. DO I = 1,K3
  547. INDLI.ID(I) = 0
  548. TAB.ID(I) = 0
  549. ENDDO
  550.  
  551. NFAC=MELEFL.NUM(/2)
  552. NBMAX = 0
  553.  
  554. C PRECALCUL DE NBMAX
  555. DO NLCF= 1, NFAC, 1
  556. c WRITE(6,*) 'NLCF= ',NLCF
  557. NGCF=MELEFL.NUM(2,NLCF)
  558. NGCG=MELEFL.NUM(1,NLCF)
  559. NGCD=MELEFL.NUM(3,NLCF)
  560. NLCG=MLECEN.LECT(NGCG)
  561. NLCD=MLECEN.LECT(NGCD)
  562. c NFAUX = MELEFA.NUM(NLCF,1)
  563. c WRITE(6,*) 'NFAUX= ',NFAUX
  564. c
  565. c NGFAUX = MELEFA.NUM(NLCF,1)
  566. c WRITE(6,*) 'NGFAUX = ',NGFAUX,
  567. c & 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  568. c NBNO = MELEFP.NUM(/1) - 1
  569. NBNO = NBCOTE(NLCF)
  570. c WRITE(6,*) 'NLCF= ',NLCF
  571. c WRITE(6,*) 'NBNO= ',NBNO
  572. MELEFP = IMECOTE(NLCF)
  573. IF (NLCF.GT.NFAI1) THEN
  574. NLCFAUX = NLCF - NFAI1
  575. ELSE
  576. NLCFAUX = NLCF
  577. ENDIF
  578. DO IA = 1,NBNO
  579. NGS1=MELEFP.NUM(IA,NLCFAUX)
  580. NLS1=MLESOM.LECT(NGS1)
  581. NLS1=MLESOM.LECT(NGS1)
  582. INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  583. NBMAX = MAX(NBMAX,INDLI.ID(NLS1))
  584. ENDDO
  585.  
  586.  
  587. ENDDO
  588.  
  589.  
  590.  
  591. SEGSUP INDLI
  592. SEGSUP TAB
  593.  
  594. c NBMAX = 6
  595. NBMAX = NBMAX +1
  596. c WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX
  597. c WRITE(6,*) 'NBSOM= ',NSOMM
  598.  
  599.  
  600.  
  601.  
  602. C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL
  603. c INITIALISATION DES MATRICES
  604. c NBMAX = 10
  605. K3 = NSOMM
  606. SEGINI INDLI
  607. SEGINI TAB
  608. DO I = 1,K3
  609. INDLI.ID(I) = 0
  610. TAB.ID(I) = 0
  611. ENDDO
  612.  
  613. K1 = NBMAX
  614. K2 = NSOMM
  615. SEGINI IND2
  616. SEGINI IND
  617. SEGINI IND22
  618. SEGINI VAL1
  619. SEGINI VAL2
  620. SEGINI SCMB
  621.  
  622. * K1 = NBMAX
  623. * K2 = (NBMAX+1)
  624.  
  625. C INITIALISATION DU POINTEUR MATRICE2
  626. K3 = NSOMM
  627. SEGINI IPO2
  628. DO I = 1,K3
  629. K1 = NBMAX
  630. K2 = NBMAX + 1
  631. SEGINI MATR1
  632. IPO2.POINT(I) = MATR1
  633. SEGDES MATR1
  634. ENDDO
  635.  
  636.  
  637.  
  638.  
  639. c DO I = 1,K3
  640. c MATR1 = IPO2.POINT(I)
  641. c SEGACT MATR1 *MOD
  642. c MATR1.MAT2(1,1) = 4.D0
  643. c MATR1.MAT2(2,2) = 3.D0
  644. c WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1)
  645. c WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2)
  646. c SEGDES MATR1
  647. c ENDDO
  648.  
  649.  
  650.  
  651.  
  652. NFAC=MELEFL.NUM(/2)
  653.  
  654. c WRITE(6,*) 'NFAC= ',NFAC
  655. NAUX1 = 0
  656. DO NLCF= 1, NFAC, 1
  657. INDICE = 0
  658.  
  659. c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION
  660. NGCF=MELEFL.NUM(2,NLCF)
  661.  
  662. NGCG=MELEFL.NUM(1,NLCF)
  663. NGCD=MELEFL.NUM(3,NLCF)
  664. NLCG=MLECEN.LECT(NGCG)
  665. NLCD=MLECEN.LECT(NGCD)
  666.  
  667.  
  668.  
  669.  
  670. SCNX=MPONOR.VPOCHA(NLCF,1)
  671. SCNY=MPONOR.VPOCHA(NLCF,2)
  672. SCNZ=MPONOR.VPOCHA(NLCF,3)
  673. SCN1X = SCNX
  674. SCN1Y = SCNY
  675. SCN1Z = SCNZ
  676.  
  677.  
  678. C 4=IDIM+1
  679. ICELL=(4*(NGCG -1))+1
  680. XG=MCOORD.XCOOR(ICELL)
  681. YG=MCOORD.XCOOR(ICELL+1)
  682. ZG=MCOORD.XCOOR(ICELL+2)
  683. ICELL=(4*(NGCD -1))+1
  684. XD=MCOORD.XCOOR(ICELL)
  685. YD=MCOORD.XCOOR(ICELL+1)
  686. ZD=MCOORD.XCOOR(ICELL+2)
  687. ICELL=(4*(NGCF -1))+1
  688. XF=MCOORD.XCOOR(ICELL)
  689. YF=MCOORD.XCOOR(ICELL+1)
  690. ZF=MCOORD.XCOOR(ICELL+2)
  691.  
  692. C MISE A ZERO DE NLOC
  693. DO JA=1,4
  694. DO IA=1,3
  695. NLOCFG(IA,JA) = 0
  696. NLOCFD(IA,JA) = 0
  697. ENDDO
  698. ENDDO
  699.  
  700. MELTFA = IMELEM(NLCG)
  701. NBF = NBFACEL(NLCG)
  702. IF (NLCG.LE.NMAI1) THEN
  703. NGAUX = NLCG
  704. ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN
  705. NGAUX = NLCG - NMAI1
  706. ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND.
  707. & (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN
  708. NGAUX = NLCG - (NMAI1+NMAI2)
  709. ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN
  710. NGAUX = NLCG - (NMAI1+NMAI2+NMAI3)
  711. ENDIF
  712. c WRITE(6,*) 'NLCG= ',NLCG
  713. c WRITE(6,*) 'NBF= ',NBF
  714. c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  715. c WRITE(6,*) 'MELTFA= ',MELTFA
  716. c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  717. c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  718. c WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2)
  719.  
  720. c SEGACT MELTFA
  721.  
  722. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  723. NLCF1 = MLEFA2.LECT(NGCF)
  724. NBNO = NBCOTE(NLCF1)
  725. MELEFP = IMECOTE(NLCF1)
  726. IF (NLCF1.GT.NFAI1) THEN
  727. NLCF1AUX = NLCF1 - NFAI1
  728. ELSE
  729. NLCF1AUX = NLCF1
  730. ENDIF
  731.  
  732. DO JA = 1,NBNO
  733. NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  734. c IF (NLCF.EQ.14) then
  735. c WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA)
  736. c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  737. c ENDIF
  738.  
  739. ICOUR = 0
  740. DO J = 1,NBF
  741. N1 = MELTFA.NUM(J,NGAUX)
  742. NL1 = MLEFA2.LECT(N1)
  743. NBNO2 = NBCOTE(NL1)
  744. MELEP2 = IMECOTE(NL1)
  745. IF (NL1.GT.NFAI1) THEN
  746. NL1AUX = NL1 - NFAI1
  747. ELSE
  748. NL1AUX = NL1
  749. ENDIF
  750. c IF (NLCF.EQ.14) then
  751. c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX
  752. c ENDIF
  753.  
  754.  
  755. DO IA =1,NBNO2
  756. NSOM1 = MELEP2.NUM(IA,NL1AUX)
  757. c IF (NLCF.EQ.14) then
  758. c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  759. c ENDIF
  760. IF (NSOM1.EQ.NGS(JA)) THEN
  761.  
  762. ICELL=(4*(N1 -1))+1
  763. XF=MCOORD.XCOOR(ICELL)
  764. YF=MCOORD.XCOOR(ICELL+1)
  765. ZF=MCOORD.XCOOR(ICELL+2)
  766.  
  767. ICOUR = ICOUR + 1
  768. VECXG(ICOUR,JA) = (XF - XG)
  769. VECYG(ICOUR,JA) = (YF - YG)
  770. VECZG(ICOUR,JA) = (ZF - ZG)
  771. NLOCFG(ICOUR,JA) = N1
  772. C ON PERMUTE
  773. C ICI
  774.  
  775. IF (N1.EQ.NGCF) THEN
  776. NAUX = NLOCFG(1,JA)
  777. VXAU = VECXG(1,JA)
  778. VYAU = VECYG(1,JA)
  779. VZAU = VECZG(1,JA)
  780. VECXG(1,JA) = (XF - XG)
  781. VECYG(1,JA) = (YF - YG)
  782. VECZG(1,JA) = (ZF - ZG)
  783. NLOCFG(1,JA) = N1
  784. VECXG(ICOUR,JA) = VXAU
  785. VECYG(ICOUR,JA) = VYAU
  786. VECZG(ICOUR,JA) = VZAU
  787. NLOCFG(ICOUR,JA) = NAUX
  788. ENDIF
  789. ENDIF
  790. ENDDO
  791. ENDDO
  792. c IF (NLCF.EQ.14) THEN
  793. c WRITE(6,*) 'JA= ',JA
  794. c WRITE(6,*) 'ICOUR= ',ICOUR
  795. c ENDIF
  796. ENDDO
  797.  
  798.  
  799. MELTFA = IMELEM(NLCD)
  800. NBF = NBFACEL(NLCD)
  801. c WRITE(6,*) 'NLCD= ',NLCD
  802. c WRITE(6,*) 'NBF= ',NBF
  803. c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  804.  
  805. IF (NLCD.LE.NMAI1) THEN
  806. NDAUX = NLCD
  807. ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN
  808. NDAUX = NLCD - NMAI1
  809. ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND.
  810. & (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN
  811. NDAUX = NLCD - (NMAI1+NMAI2)
  812. ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN
  813. NDAUX = NLCD - (NMAI1+NMAI2+NMAI3)
  814. ENDIF
  815.  
  816. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  817. DO JA = 1,NBNO
  818. NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  819. c WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA)
  820. c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  821. ICOUR = 0
  822. DO J = 1,NBF
  823. N1 = MELTFA.NUM(J,NDAUX)
  824. NL1 = MLEFA2.LECT(N1)
  825. c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1
  826.  
  827. NBNO2 = NBCOTE(NL1)
  828. MELEP2 = IMECOTE(NL1)
  829. IF (NL1.GT.NFAI1) THEN
  830. NL1AUX = NL1 - NFAI1
  831. ELSE
  832. NL1AUX = NL1
  833. ENDIF
  834.  
  835.  
  836. DO IA =1,NBNO2
  837. NSOM1 = MELEP2.NUM(IA,NL1AUX)
  838. c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  839. IF (NSOM1.EQ.NGS(JA)) THEN
  840.  
  841. ICELL=(4*(N1 -1))+1
  842. XF=MCOORD.XCOOR(ICELL)
  843. YF=MCOORD.XCOOR(ICELL+1)
  844. ZF=MCOORD.XCOOR(ICELL+2)
  845.  
  846. ICOUR = ICOUR + 1
  847. VECXD(ICOUR,JA) = (XF - XD)
  848. VECYD(ICOUR,JA) = (YF - YD)
  849. VECZD(ICOUR,JA) = (ZF - ZD)
  850. NLOCFD(ICOUR,JA) = N1
  851. C ON PERMUTE
  852. IF (N1.EQ.NGCF) THEN
  853. NAUX = NLOCFD(1,JA)
  854. VXAU = VECXD(1,JA)
  855. VYAU = VECYD(1,JA)
  856. VZAU = VECZD(1,JA)
  857. VECXD(1,JA) = (XF - XD)
  858. VECYD(1,JA) = (YF - YD)
  859. VECZD(1,JA) = (ZF - ZD)
  860. NLOCFD(1,JA) = N1
  861. VECXD(ICOUR,JA) = VXAU
  862. VECYD(ICOUR,JA) = VYAU
  863. VECZD(ICOUR,JA) = VZAU
  864. NLOCFD(ICOUR,JA) = NAUX
  865. ENDIF
  866. ENDIF
  867. ENDDO
  868. ENDDO
  869. c WRITE(6,*) 'JA= ',JA
  870. c WRITE(6,*) 'ICOUR= ',ICOUR
  871. ENDDO
  872.  
  873. CALCUL DES VOLUMES
  874. c DO JA = 1,NBNO
  875. c DO KA=1,ICOUR
  876. c WRITE(6,*)'JA= ',JA,'KA= ',KA
  877. c WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  878. c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  879. c ENDDO
  880. c ENDDO
  881.  
  882. DO JA = 1,NBNO
  883.  
  884. DO KA = 1,ICOUR
  885. C PRODUIT MIXTES
  886. C PRODUIT VECTORIEL
  887. IF (KA.EQ.1) THEN
  888. PSCAGX = (VECYG(2,JA)*VECZG(3,JA)) -
  889. & (VECZG(2,JA)*VECYG(3,JA))
  890. PSCAGY = (VECZG(2,JA)*VECXG(3,JA)) -
  891. & (VECXG(2,JA)*VECZG(3,JA))
  892. PSCAGZ = (VECXG(2,JA)*VECYG(3,JA)) -
  893. & (VECYG(2,JA)*VECXG(3,JA))
  894. VOLUG(JA) = (VECXG(1,JA)* PSCAGX) +
  895. & (VECYG(1,JA)* PSCAGY) +
  896. & (VECZG(1,JA)* PSCAGZ)
  897. SURFAGX(KA) = 0.5D0* PSCAGX
  898. SURFAGY(KA) = 0.5D0* PSCAGY
  899. SURFAGZ(KA) = 0.5D0* PSCAGZ
  900. IF ( VOLUG(JA).GT.0) THEN
  901. SURFAGX(KA) = - SURFAGX(KA)
  902. SURFAGY(KA) = - SURFAGY(KA)
  903. SURFAGZ(KA) = - SURFAGZ(KA)
  904. ENDIF
  905. VOLUG(JA) = 1.D0/6.D0*ABS(VOLUG(JA))
  906. ENDIF
  907.  
  908. IF (KA.EQ.2) THEN
  909. PSCAGX = (VECYG(3,JA)*VECZG(1,JA)) -
  910. & (VECZG(3,JA)*VECYG(1,JA))
  911. PSCAGY = (VECZG(3,JA)*VECXG(1,JA)) -
  912. & (VECXG(3,JA)*VECZG(1,JA))
  913. PSCAGZ = (VECXG(3,JA)*VECYG(1,JA)) -
  914. & (VECYG(3,JA)*VECXG(1,JA))
  915. SURFAGX(KA) = 0.5D0* PSCAGX
  916. SURFAGY(KA) = 0.5D0* PSCAGY
  917. SURFAGY(KA) = 0.5D0* PSCAGY
  918. SURFAGZ(KA) = 0.5D0* PSCAGZ
  919. PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) +
  920. & (VECZG(2,JA)* PSCAGZ)
  921. IF ( PSCA.GT.0) THEN
  922. SURFAGX(KA) = - SURFAGX(KA)
  923. SURFAGY(KA) = - SURFAGY(KA)
  924. SURFAGZ(KA) = - SURFAGZ(KA)
  925. ENDIF
  926. ENDIF
  927.  
  928.  
  929. IF (KA.EQ.3) THEN
  930. PSCAGX = (VECYG(1,JA)*VECZG(2,JA)) -
  931. & (VECZG(1,JA)*VECYG(2,JA))
  932. PSCAGY = (VECZG(1,JA)*VECXG(2,JA)) -
  933. & (VECXG(1,JA)*VECZG(2,JA))
  934. PSCAGZ = (VECXG(1,JA)*VECYG(2,JA)) -
  935. & (VECYG(1,JA)*VECXG(2,JA))
  936.  
  937. SURFAGX(KA) = 0.5D0* PSCAGX
  938. SURFAGY(KA) = 0.5D0* PSCAGY
  939. SURFAGZ(KA) = 0.5D0* PSCAGZ
  940. PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) +
  941. & (VECZG(3,JA)* PSCAGZ)
  942. IF ( PSCA.GT.0) THEN
  943. SURFAGX(KA) = - SURFAGX(KA)
  944. SURFAGY(KA) = - SURFAGY(KA)
  945. SURFAGZ(KA) = - SURFAGZ(KA)
  946. ENDIF
  947. ENDIF
  948.  
  949. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  950. IF (ICHTE.EQ.0) THEN
  951. COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) +
  952. & (SURFAGZ(KA)*SCN1Z))
  953. & / (3.D0*VOLUG(JA))
  954.  
  955. ELSE
  956. C TENSEUR
  957. IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  958. K11G = MPOTEN.VPOCHA(NLCG,1)
  959. K22G = MPOTEN.VPOCHA(NLCG,2)
  960. K33G = MPOTEN.VPOCHA(NLCG,3)
  961. K21G = MPOTEN.VPOCHA(NLCG,4)
  962. K31G = MPOTEN.VPOCHA(NLCG,5)
  963. K32G = MPOTEN.VPOCHA(NLCG,6)
  964. ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  965. K11G = MPOTEN.VPOCHA(NLCG,1)
  966. K22G = K11G
  967. K33G = K11G
  968. K21G = 0.0D0
  969. K31G = 0.0D0
  970. K32G = 0.0D0
  971. ELSE
  972. WRITE(6,*) 'TENSEUR NON PREVU'
  973. STOP
  974. ENDIF
  975.  
  976. PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) +
  977. & (K31G*SURFAGZ(KA))
  978. PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) +
  979. & (K32G*SURFAGZ(KA))
  980. PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) +
  981. & (K33G*SURFAGZ(KA))
  982. COEFG(KA,JA) = (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) +
  983. & (PSCAGZ*SCN1Z)
  984. COEFG(KA,JA) = COEFG(KA,JA) / (3.D0*VOLUG(JA))
  985. ENDIF
  986. c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA)
  987. c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  988. c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  989. c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  990. ENDDO
  991. c WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA)
  992. c WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  993. c WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  994. c WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  995. c WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  996. c & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  997. c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  998. c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  999. c WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1000. c WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1001.  
  1002. ENDDO
  1003. CALCUL DES VOLUMES
  1004.  
  1005. DO JA = 1,NBNO
  1006. NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  1007. NLS(JA)=MLESOM.LECT(NGS(JA))
  1008.  
  1009. DO KA = 1,ICOUR
  1010. C PRODUIT MIXTES
  1011. C PRODUIT VECTORIEL
  1012. IF (KA.EQ.1) THEN
  1013. PSCADX = (VECYD(2,JA)*VECZD(3,JA)) -
  1014. & (VECZD(2,JA)*VECYD(3,JA))
  1015. PSCADY = (VECZD(2,JA)*VECXD(3,JA)) -
  1016. & (VECXD(2,JA)*VECZD(3,JA))
  1017. PSCADZ = (VECXD(2,JA)*VECYD(3,JA)) -
  1018. & (VECYD(2,JA)*VECXD(3,JA))
  1019. VOLUD(JA) = (VECXD(1,JA)* PSCADX) +
  1020. & (VECYD(1,JA)* PSCADY) +
  1021. & (VECZD(1,JA)* PSCADZ)
  1022. SURFADX(KA) = 0.5D0* PSCADX
  1023. SURFADY(KA) = 0.5D0* PSCADY
  1024. SURFADZ(KA) = 0.5D0* PSCADZ
  1025. IF ( VOLUD(JA).GT.0) THEN
  1026. SURFADX(KA) = - SURFADX(KA)
  1027. SURFADY(KA) = - SURFADY(KA)
  1028. SURFADZ(KA) = - SURFADZ(KA)
  1029. ENDIF
  1030. VOLUD(JA) = 1.D0/6.D0*ABS(VOLUD(JA))
  1031.  
  1032. ENDIF
  1033.  
  1034. IF (KA.EQ.2) THEN
  1035. PSCADX = (VECYD(3,JA)*VECZD(1,JA)) -
  1036. & (VECZD(3,JA)*VECYD(1,JA))
  1037. PSCADY = (VECZD(3,JA)*VECXD(1,JA)) -
  1038. & (VECXD(3,JA)*VECZD(1,JA))
  1039. PSCADZ = (VECXD(3,JA)*VECYD(1,JA)) -
  1040. & (VECYD(3,JA)*VECXD(1,JA))
  1041. SURFADX(KA) = 0.5D0* PSCADX
  1042. SURFADY(KA) = 0.5D0* PSCADY
  1043. SURFADY(KA) = 0.5D0* PSCADY
  1044. SURFADZ(KA) = 0.5D0* PSCADZ
  1045. PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) +
  1046. & (VECZD(2,JA)* PSCADZ)
  1047. IF ( PSCA.GT.0) THEN
  1048. SURFADX(KA) = - SURFADX(KA)
  1049. SURFADY(KA) = - SURFADY(KA)
  1050. SURFADZ(KA) = - SURFADZ(KA)
  1051. ENDIF
  1052. ENDIF
  1053.  
  1054.  
  1055. IF (KA.EQ.3) THEN
  1056. PSCADX = (VECYD(1,JA)*VECZD(2,JA)) -
  1057. & (VECZD(1,JA)*VECYD(2,JA))
  1058. PSCADY = (VECZD(1,JA)*VECXD(2,JA)) -
  1059. & (VECXD(1,JA)*VECZD(2,JA))
  1060. PSCADZ = (VECXD(1,JA)*VECYD(2,JA)) -
  1061. & (VECYD(1,JA)*VECXD(2,JA))
  1062.  
  1063. SURFADX(KA) = 0.5D0* PSCADX
  1064. SURFADY(KA) = 0.5D0* PSCADY
  1065. SURFADZ(KA) = 0.5D0* PSCADZ
  1066. PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) +
  1067. & (VECZD(3,JA)* PSCADZ)
  1068. IF ( PSCA.GT.0) THEN
  1069. SURFADX(KA) = - SURFADX(KA)
  1070. SURFADY(KA) = - SURFADY(KA)
  1071. SURFADZ(KA) = - SURFADZ(KA)
  1072. ENDIF
  1073. ENDIF
  1074.  
  1075. c WRITE(6,*) 'NLCF=',NLCF
  1076. c WRITE(6,*) 'NLCD=',NLCD
  1077. c WRITE(6,*) 'NLCG=',NLCG
  1078. c WRite(6,*) 'AG1=',AG1
  1079. c WRite(6,*) 'AG2=',AG2
  1080. c WRite(6,*) 'AD1=',AD1
  1081. c WRite(6,*) 'AD2=',AD2
  1082. c WRite(6,*) 'PSCAG1=',PSCAG1
  1083. c WRite(6,*) 'PSCAG2=',PSCAG2
  1084. c WRite(6,*) 'PSCAD1=',PSCAD1
  1085. c WRite(6,*) 'PSCAD2=',PSCAD2
  1086. c WRite(6,*) 'COEF1D=',COEF1D
  1087. c WRite(6,*) 'COEF2D=',COEF2D
  1088. c WRite(6,*) 'BETA1GD=',BETA1GD
  1089. c WRite(6,*) 'BETA2GD=',BETA2GD
  1090. c WRite(6,*) 'INDD2=',INDD2
  1091.  
  1092. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  1093. IF (ICHTE.EQ.0) THEN
  1094. COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) +
  1095. & (SURFADZ(KA)*SCN1Z))
  1096. & / (3.D0*VOLUD(JA))
  1097.  
  1098. ELSE
  1099. C TENSEUR
  1100. IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  1101. K11D = MPOTEN.VPOCHA(NLCD,1)
  1102. K22D = MPOTEN.VPOCHA(NLCD,2)
  1103. K33D = MPOTEN.VPOCHA(NLCD,3)
  1104. K21D = MPOTEN.VPOCHA(NLCD,4)
  1105. K31D = MPOTEN.VPOCHA(NLCD,5)
  1106. K32D = MPOTEN.VPOCHA(NLCD,6)
  1107. ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  1108. K11D = MPOTEN.VPOCHA(NLCD,1)
  1109. K22D = K11D
  1110. K33D = K11D
  1111. K21D = 0.0D0
  1112. K31D = 0.0D0
  1113. K32D = 0.0D0
  1114. ELSE
  1115. WRITE(6,*) 'TENSEUR NON PREVU'
  1116. STOP
  1117. ENDIF
  1118.  
  1119. PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) +
  1120. & (K31D*SURFADZ(KA))
  1121. PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) +
  1122. & (K32D*SURFADZ(KA))
  1123. PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) +
  1124. & (K33D*SURFADZ(KA))
  1125. COEFD(KA,JA) = (PSCADX*SCN1X) + (PSCADY*SCN1Y)
  1126. & + (PSCADZ*SCN1Z)
  1127. COEFD(KA,JA) = COEFD(KA,JA) / (3.D0*VOLUD(JA))
  1128. ENDIF
  1129. c WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA) = ',VOLUD(JA)
  1130. c WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA)
  1131. c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  1132. ENDDO
  1133.  
  1134. c WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA)
  1135. c WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1136. c WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1137. c WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1138. c WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1139. c & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1140. c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1141. c WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1142. c WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1143. c WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1144.  
  1145. ENDDO
  1146. CALCUL DES VOLUMES
  1147.  
  1148. c WRITE(6,*) 'NLCF= ',NLCF
  1149. c WRITE(6,*) 'NGCF= ',NGCF
  1150. c WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1151. c WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1152. DO JA = 1,NBNO
  1153.  
  1154. XX1 = ABS(COEFG(1,JA))
  1155. XX2 = ABS(COEFD(1,JA))
  1156. IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN
  1157. INDICE = 1
  1158. ENDIF
  1159.  
  1160. MARQ = 0
  1161. DO I5 = 1,INDLI.ID(NLS(JA))
  1162. INDAUX = IND2.NUME(I5,NLS(JA))
  1163. IF (INDAUX.EQ.NGCF) THEN
  1164. MARQ = 1
  1165. IAFF = I5
  1166. GOTO 4
  1167. ENDIF
  1168. ENDDO
  1169. 4 CONTINUE
  1170.  
  1171.  
  1172. IF (MARQ.EQ.0) THEN
  1173. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1174. ICOU = INDLI.ID(NLS(JA))
  1175. IND2.NUME(ICOU,NLS(JA)) = NGCF
  1176. ELSE
  1177. ICOU = IAFF
  1178. ENDIF
  1179.  
  1180.  
  1181. COEF = COEFG(1,JA)-COEFD(1,JA)
  1182. MATR1 = IPO2.POINT(NLS(JA))
  1183. c SEGINI MATR1
  1184. SEGACT MATR1 *MOD
  1185. MATR1.MAT2(ICOU,ICOU) = COEF
  1186.  
  1187. MARQ = 0
  1188. DO I5 = 1,INDLI.ID(NLS(JA))
  1189. INDAUX = IND2.NUME(I5,NLS(JA))
  1190. IF (INDAUX.EQ.NLOCFG(2,JA)) THEN
  1191. MARQ = 1
  1192. IAFF = I5
  1193. GOTO 5
  1194. ENDIF
  1195. ENDDO
  1196. 5 CONTINUE
  1197.  
  1198.  
  1199. IF (MARQ.EQ.0) THEN
  1200. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1201. ICOUCO = INDLI.ID(NLS(JA))
  1202. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(2,JA)
  1203. ELSE
  1204. ICOUCO = IAFF
  1205. ENDIF
  1206. ICOUG2 = ICOUCO
  1207.  
  1208.  
  1209. MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA)
  1210.  
  1211. MARQ = 0
  1212. DO I5 = 1,INDLI.ID(NLS(JA))
  1213. INDAUX = IND2.NUME(I5,NLS(JA))
  1214. IF (INDAUX.EQ.NLOCFG(3,JA)) THEN
  1215. MARQ = 1
  1216. IAFF = I5
  1217. GOTO 6
  1218. ENDIF
  1219. ENDDO
  1220. 6 CONTINUE
  1221.  
  1222.  
  1223. IF (MARQ.EQ.0) THEN
  1224. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1225. ICOUCO = INDLI.ID(NLS(JA))
  1226. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA)
  1227. ELSE
  1228. ICOUCO = IAFF
  1229. ENDIF
  1230. ICOUG3 = ICOUCO
  1231. MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA)
  1232.  
  1233.  
  1234. MARQ = 0
  1235. DO I5 = 1,INDLI.ID(NLS(JA))
  1236. INDAUX = IND2.NUME(I5,NLS(JA))
  1237. IF (INDAUX.EQ.NLOCFD(2,JA)) THEN
  1238. MARQ = 1
  1239. IAFF = I5
  1240. GOTO 59
  1241. ENDIF
  1242. ENDDO
  1243. 59 CONTINUE
  1244.  
  1245.  
  1246. IF (MARQ.EQ.0) THEN
  1247. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1248. ICOUCO = INDLI.ID(NLS(JA))
  1249. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(2,JA)
  1250. ELSE
  1251. ICOUCO = IAFF
  1252. ENDIF
  1253. ICOUD2 = ICOUCO
  1254.  
  1255.  
  1256. MATR1.MAT2(ICOU,ICOUCO) = - COEFD(2,JA)
  1257.  
  1258. MARQ = 0
  1259. DO I5 = 1,INDLI.ID(NLS(JA))
  1260. INDAUX = IND2.NUME(I5,NLS(JA))
  1261. IF (INDAUX.EQ.NLOCFD(3,JA)) THEN
  1262. MARQ = 1
  1263. IAFF = I5
  1264. GOTO 69
  1265. ENDIF
  1266. ENDDO
  1267. 69 CONTINUE
  1268.  
  1269.  
  1270. IF (MARQ.EQ.0) THEN
  1271. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1272. ICOUCO = INDLI.ID(NLS(JA))
  1273. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA)
  1274. ELSE
  1275. ICOUCO = IAFF
  1276. ENDIF
  1277. ICOUD3 = ICOUCO
  1278. MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA)
  1279.  
  1280. c ON EST ICI
  1281.  
  1282. SCMB.MAT(ICOU,NLS(JA)) =
  1283. & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))
  1284. & *MPOCHP.VPOCHA(NLCG,1)) -
  1285. & ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))*
  1286. & MPOCHP.VPOCHA(NLCD,1))
  1287. c SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA))
  1288.  
  1289.  
  1290. c NLS1 = NLS(JA)
  1291. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1292. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1293. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1294. c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1295. c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1296. c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1297. c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3)
  1298. * ON EST ICI
  1299. * IL FAUT VERIFIER CE QUI EST AVANT
  1300.  
  1301.  
  1302. * COEF POUR INVERSER LA MATRICE
  1303.  
  1304. * ON CORRIGE ICI
  1305. VAL1.MAT(ICOU,NLS(JA)) =
  1306. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1307. c VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA))
  1308. VAL2.MAT(ICOU,NLS(JA)) =
  1309. & - (COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA))
  1310. c VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA))
  1311. IND.NUME(ICOU,NLS(JA)) = NGCG
  1312. IND22.NUME(ICOU,NLS(JA)) = NGCD
  1313.  
  1314. * CONDITION AUX LIMITE DE DIRICICHLET
  1315. IF (NGCG.EQ.NGCD) THEN
  1316. NLFCL=MLENCL.LECT(NGCF)
  1317. IF (NLFCL.GT.0) THEN
  1318. c WRITE(6,*) 'NLCF= ',NLCF
  1319. c WRITE(6,*) 'NGCF= ',NGCF
  1320. c WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1)
  1321. COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA)))
  1322. COEF = MAX(COEF,ABS(COEFG(3,JA)))
  1323. MATR1.MAT2(ICOU,ICOU) = COEF
  1324. MATR1.MAT2(ICOU,ICOUG2) = 0.0D0
  1325. MATR1.MAT2(ICOU,ICOUG3) = 0.0D0
  1326. MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1327. MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1328. SCMB.MAT(ICOU,NLS(JA)) = (COEF*MPOVCL.VPOCHA(NLFCL,1))
  1329. VAL1.MAT(ICOU,NLS(JA)) = 0.D0
  1330. VAL2.MAT(ICOU,NLS(JA)) = COEF
  1331. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  1332. IND.NUME(ICOU,NLS(JA)) = NGCG
  1333. IND22.NUME(ICOU,NLS(JA)) = NGCF
  1334. ELSE
  1335. NLFNE=MLENNE.LECT(NGCF)
  1336.  
  1337. c CONDITION DE FLUX
  1338. IF (NLFNE.GT.0) THEN
  1339. QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  1340. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1341. QIMPS = (QIMPX)
  1342. c WRITE(6,*) 'NGCF= ',NGCF
  1343. c WRITE(6,*) 'QIMPS= ',QIMPS
  1344.  
  1345. COEF = COEFG(1,JA)
  1346. MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1347. MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1348. MATR1.MAT2(ICOU,ICOU) = COEF
  1349. MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA)
  1350. MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA)
  1351.  
  1352. SCMB.MAT(ICOU,NLS(JA)) =
  1353. & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1354. & + (QIMPS)
  1355. VAL1.MAT(ICOU,NLS(JA)) =
  1356. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1357. VAL2.MAT(ICOU,NLS(JA)) = 1.D0
  1358. IND.NUME(ICOU,NLS(JA)) = NGCG
  1359. IND22.NUME(ICOU,NLS(JA)) = NGCF
  1360. NLS1 = NLS(JA)
  1361. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1362. c & 'SCMB', SCMB.MAT(ICOU,NLS1)
  1363. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1364. c & 'IND= ',IND.NUME(ICOU,NLS1),
  1365. c & 'IND22= ',IND22.NUME(ICOU,NLS1),
  1366. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1367. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1368. c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1369. c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1370. c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1371. c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1372.  
  1373. ELSE
  1374. c CONDITION MIXTE
  1375. NLFMI=MLENMI.LECT(NGCF)
  1376. IF (NLFMI.GT.0) THEN
  1377. XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  1378. XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  1379. QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  1380. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1381. QIMPS = (QIMPX)
  1382.  
  1383. c WRITE(6,*) 'NLCF= ',NLCF
  1384. c WRITE(6,*) 'NGCF= ',NGCF
  1385. c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  1386. COEF = COEFG(1,JA)
  1387. c WRITE(6,*) 'COEF= ',COEF
  1388. c WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS
  1389. MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1390. MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1391. MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) -
  1392. & (1.D0*XLAMBDA2)
  1393. MATR1.MAT2(ICOU,ICOUG2) = (XLAMBDA1*COEFG(2,JA))
  1394. MATR1.MAT2(ICOU,ICOUG3) = (XLAMBDA1*COEFG(3,JA))
  1395. c ON EST ICI
  1396. SCMB.MAT(ICOU,NLS(JA)) =
  1397. & (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*
  1398. & MPOCHP.VPOCHA(NLCG,1)))
  1399. & + (1.D0*QIMPS)
  1400. VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1*
  1401. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1402. VAL2.MAT(ICOU,NLS(JA)) = 1.D0
  1403. IND.NUME(ICOU,NLS(JA)) = NGCG
  1404. IND22.NUME(ICOU,NLS(JA)) = NGCF
  1405. NLS1 = NLS(JA)
  1406. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1407. c & 'IND= ',IND.NUME(ICOU,NLS1),
  1408. c & 'IND22= ',IND22.NUME(ICOU,NLS1),
  1409. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1410. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1411. c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1412. c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1413. c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1414. c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1415. ELSE
  1416. C PAR DEFAUT FLUX NUL
  1417. QIMPS = 0
  1418. COEF = COEFG(1,JA)
  1419. MATR1.MAT2(ICOU,ICOU) = COEF
  1420. MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA)
  1421. MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA)
  1422. SCMB.MAT(ICOU,NLS(JA)) =
  1423. & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1424. VAL1.MAT(ICOU,NLS(JA)) =
  1425. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1426. VAL2.MAT(ICOU,NLS(JA)) = 0.D0
  1427. IND.NUME(ICOU,NLS(JA)) = NGCG
  1428. IND22.NUME(ICOU,NLS(JA)) = NGCD
  1429. ENDIF
  1430.  
  1431. ENDIF
  1432.  
  1433. ENDIF
  1434. ENDIF
  1435.  
  1436. c WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ',
  1437. c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  1438. c & 'HD= ',MPOCHP.VPOCHA(NLCD,1)
  1439.  
  1440. NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA)))
  1441. c WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1
  1442. c WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA),
  1443. c & 'INDLI.ID',INDLI.ID(NLS(JA))
  1444. c WRITE(6,*) 'JA= ',JA
  1445. c WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA)
  1446. c WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA)
  1447. c DO I5 = 1,INDLI.ID(NLS(JA))
  1448. c INDAUX = IND2.NUME(I5,NLS(JA))
  1449. c WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA),
  1450. c & 'IND2= ',IND2.NUME(I5,NLS(JA))
  1451. c ENDDO
  1452.  
  1453. C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS)
  1454. c SEGDES MATRICE2
  1455. c SEGACT MATRICE2
  1456. NLS1 = NLS(JA)
  1457. IF (ABS(COEF).LT. (-1.D0)) THEN
  1458. NLFCL=MLENCL.LECT(NGCF)
  1459. WRITE(6,*) 'CLIMD = ',NLFCL
  1460. NLFNE=MLENNE.LECT(NGCF)
  1461. WRITE(6,*) 'CLIMN = ',NLFNE
  1462. WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1463. & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1464. & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1465. & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1466. & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1467. & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1468. & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3),
  1469. & 'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA)
  1470.  
  1471. c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA)
  1472. c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  1473. c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  1474. WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1475. WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA)
  1476. WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  1477. WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  1478. WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  1479. WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1480. & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1481. WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1482. WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1483. WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1484. WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1485.  
  1486. WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA)
  1487. WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1488. WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1489. WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1490. WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1491. & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1492. WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1493. WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1494. WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1495. WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1496. WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1497. WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1498.  
  1499. ENDIF
  1500.  
  1501. SEGDES MATR1 * MOD
  1502.  
  1503. ENDDO
  1504.  
  1505.  
  1506.  
  1507. c IF (INDICE.EQ.1) THEN
  1508. c WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT'
  1509. c ENDIF
  1510. ENDDO
  1511.  
  1512.  
  1513. IF (NAUX1.GT.NBMAX) THEN
  1514. WRITE(6,*) 'ERREUR DANS LES PARAMETRES'
  1515. c STOP
  1516. ENDIF
  1517. c DO J= 1,INDLI.ID(NLS1)
  1518. c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF)
  1519. c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF)
  1520. c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF)
  1521. c ENDDO
  1522.  
  1523. MELTFA = MAUX
  1524. MELEFP = MAUX2
  1525. IF (NBSO.EQ.2) THEN
  1526. SEGDES IPT1
  1527. SEGDES IPT2
  1528. ELSEIF (NBSO.EQ.3) THEN
  1529. SEGDES IPT1
  1530. SEGDES IPT2
  1531. SEGDES IPT3
  1532. ELSEIF (NBSO.EQ.4) THEN
  1533. SEGDES IPT1
  1534. SEGDES IPT2
  1535. SEGDES IPT3
  1536. SEGDES IPT4
  1537. ENDIF
  1538. IF (NBSOF.EQ.2) THEN
  1539. SEGDES IPT5
  1540. SEGDES IPT6
  1541. ENDIF
  1542.  
  1543. c MAUX = MELEFP
  1544. c MELEFP = IMECOTE(1)
  1545. c NGCF=MELEFP.NUM(4,1)
  1546. c WRITE(6,*) 'NGCF= ',NGCF
  1547. c MELEFP = MAUX
  1548.  
  1549. c DO NLS1=1,NSOMM,1
  1550. c MATR1 = IPO2.POINT(NLS1)
  1551. c SEGACT MATR1
  1552. c
  1553. c DO I=1,INDLI.ID(NLS1)
  1554. c DO J = 1,INDLI.ID(NLS1)
  1555. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J)
  1556. c ENDDO
  1557. c ENDDO
  1558. c ENDDO
  1559. c SEGDES MATR1
  1560.  
  1561. 9999 CONTINUE
  1562. RETURN
  1563. END
  1564.  
  1565.  
  1566.  
  1567.  
  1568.  
  1569.  
  1570.  
  1571.  
  1572.  
  1573.  
  1574.  
  1575.  
  1576.  
  1577.  
  1578.  

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